perm filename DSKSER.17B[J17,SYS] blob
sn#109714 filedate 1974-07-07 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00038 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00004 00002 BEGIN DSKSER ↔ SUBTTL DSKSER DISK SERVICE ROUTINE
C00006 00003 IOS BITS, DISPATCH TABLE
C00008 00004 DISKUP DHUNG BLAST DISK. DISK HUNG ROUTINE
C00010 00005 SETDDB CLRDDB CORE ALLOCATION ROUTINES
C00013 00006 REFRES DISK REFRESHER (I. E., INITIALIZER)
C00017 00007 TIME CONTROL. INFORMATION KEPT AS FOLLOWS:
C00025 00008 BUFFERED I/O
C00034 00009 DUMP MODE I/O
C00038 00010 DUMP MODE INPUT
C00043 00011 DUMP MODE OUTPUT
C00047 00012 BOTH INPUT & OUTPUT CLOSE ARE ALWAYS CALLED FROM UUOCON.
C00052 00013 RELEASE UUO, CALL RESET, AND CALL EXIT
C00056 00014 MTAPE UUO -- BY R. HELLIWELL -- 16 JAN 72
C00061 00015 GDWRIT, GDREAD
C00065 00016 SETSAT, CLRSAT
C00067 00017 SATWRT, SATRD, SATFRC
C00070 00018 FILINF, WRTINF
C00075 00019 WRTOFF, RDOFF
C00078 00020 DIAGL, DIAGW
C00081 00021 GETRTR
C00084 00022 INFCOM, ADDBLK, FILEUP
C00088 00023 LOOKUP
C00095 00024 ENTER
C00103 00025 RENAME
C00114 00026 FILE ACCESS CONTROL.
C00120 00027 SEARCH MFD AND UFD FOR FILE.
C00130 00028 RETRIEVAL SUBRS
C00139 00029 SAT TABLE OPERATIONS
C00142 00030 IASNBK
C00145 00031 DELETE A FILE, FREE DISK BLOCKS
C00147 00032 SWAPPER INTERFACE
C00151 00033 ENTER HERE FOR HIGH PRIORITY TRANSFER (CURRENTLY ONLY UDP IO).
C00155 00034 I-LEVEL SUBRS RETURN HERE WHEN DONE TO START ANOTHER REQUEST.
C00158 00035 I-LEVEL SUBRS PUSHJ HERE TO START A TRANSFER.
C00159 00036 SUBTTL ERROR HANDLING
C00163 00037 USER DISK PACK SERVICE
C00168 00038 UDP PASS WORD STUFF
C00171 ENDMK
C⊗;
BEGIN DSKSER ↔ SUBTTL DSKSER DISK SERVICE ROUTINE
↑DEVBEG←←. ;START OF THE DEV SERVICES IN ENTIRE SYSTEM
DEFINE IOPCON <DIPCON>
; PRELIMINARIES, STORAGE CONTROL
;THIS CODE DEPENDS HEAVILY UPON:
; 1) NO RESCHEDULING AT UUO LEVEL
; 2) JOB NOT SHUFFLED OR SWAPPED WHEN IO ACTIVE.
TRIES←←1 ;ASK DSKINT TO TRY A TRANSFER THIS MANY TIMES
ERRBOX←←1 ;PLACE FOR ENTER, LOOKUP ERROR CODES
BUFIOW: XWD -BLKWDS,SYSBUF ;167 FORMAT
UFDEXT←←'UFD' ;SIXBIT UFD.
↑MFDENT: ' 1 1' ;'DIRECTORY ENTRY' FOR MFD
MFDEXT: 'UFD '
MFDPRO: 155740,,0 ;ANYONE CAN READ THE MFD
MFDLOC: 1 ;DISK LOC. OF MFD
↑BAND0: 0
↑SATLOC: 0
UNAM←←0
UEXT←←1
UPRO←←2
UPPN←←3
DWRITE←←100 ;TELL 167 TO WRITE, ELSE READ.
IOPDCH←←IOPCHN ;HI PRIORITY CHANNEL FOR 167
MSGPPN: ' 2 2' ;PPN OF MESSAGE AREA
;IOS BITS, DISPATCH TABLE
;BITS IN LH IOS INDICATE FILE STATUS:
↑GOBIT←←400000
↑READB←←200000
↑WRITEB←←100000
↑ALTERB←←40000
RENAMB←←20000
DELETB←←10000
NTRUFD←←4000
PNTDIF←←2000
IOSET←←400 ;CHEAT FOR USETI IN CLOSE
LOSBIG←←200
SATOP←←100
HDRDIF←←4 ;HOPEFULLY WE CAN GET AWAY WITH THIS ONE, (SAME BIT AS IOFST!)
↑DSKFGS←←SATOP+GOBIT
;USER STATUS BITS IN RH IOS:
DMPBIT←←400
GARBIT←←200
;IDENTIFY DDB LOCATIONS FOR TVSER. LOCATIONS ARE SAME
;AS IN BLACKINGTON, FOR NO GOOD REASON.
↑DSKBUF←←17
↑DSKCNT←←20
JRST CLRDDB ;GIVE BACK DDB
JRST SETDDB ;MAKE DDB
JRST DSKINI ;INITIALIZATION (SYSINI)
JRST DHUNG ;SHOULDN'T HANG
↑DSKDSP:JRST DRELES ;RELEASE
JRST DCLOSO ;CLOSE OUTPUT
JRST DBUFO ;BUFFERED OUTPUT
JRST DBUFI ;BUFFERED INPUT
JRST DENTER ;ENTER
JRST DLOOK ;LOOKUP
JRST DDMPO ;DUMP OUTPUT
JRST DDMPI ;DUMP INPUT
JRST DSETO ;USETO
JRST DSETI ;USETI
JRST DGETF ;UGETF
JRST DRENAM ;RENAME
JRST DCLOSI ;CLOSE INPUT
POPJ P, ;UTPCLR
JRST DGETW ;MTAPE
;DISKUP DHUNG BLAST DISK. DISK HUNG ROUTINE
DISKUP: CONO IBM,CLRCHL
MOVEI TAC1,2 ;MAY TAKE THIS MANY IF SCREWED UP.
DSKUP2: CONO IBM,1 ;.....
CONO IBM,2 ;NOW RESET IBM.
MOVEI TAC,10000 ;...WHICH MAY TAKE A WHILE.
SOJG TAC,.
SOJGE TAC1,DSKUP2
CONO PMP,460010!DSKCHN ;ENABLE FOR RANDOM INT'S
POPJ P,
;CALLED FROM DEVCHK BY SPECIAL CALL, DDB NOT SETUP
DHUNG: PUSHJ P,DISKUP ;FLUSH THE WORLD.
CONO PMP,10 ;MAKE SURE CHANNEL DOESN'T INTERRUPT ANYONE
DATAO IBM,NOPCMD ;NOW SEE IF HE IS LISTENING TO US
MOVEI TAC,100000 ;WAIT THIS LONG
CONSO PMP,460000 ;WAIT FOR NEW STATUS, UNEND, OR PARITY ERROR.
SOJG TAC,.-1 ;WAIT FOR SOME STATUS
CONI PMP,TAC ;GET GOOD BITS
TRC TAC,600 ;CHANNEL END, DEVICE END
TRCN TAC,600 ;DID WE GET THEM BOTH?
JRST OKNOW ;YES. PERHAPS THE DISK IS HAPPY NOW
PUSHACS
PUSHJ P,DISDATE
PUSHJ P,DISMES
ASCIZ /RESET DISK. THEN PUSH CONTINUE.
/
SETOM DISFLAG
PUSHJ P,DISFLUSH ;MAKE SURE THEY SEE IT
POPACS
HALT .+1
PUSHJ P,DISKUP ;BLAST HIM AGAIN
OKNOW: CONO PI,PIOFF ;MAKE SURE WE DON'T LOSE
SETOM HNGFLG ;TELL DSKINT WHY
CONO PMP,660010!DSKCHN ;MAKE AN INTERRUPT ON DISK CHANNEL
CONO PI,PION
POPJ P,
;SETDDB CLRDDB CORE ALLOCATION ROUTINES
↑SETDDB: ;CALLED BY ASSASG IN IOCSS FOR INIT UUO.
PUSHJ P,GCOR1
HRRI DDB,DDBSKW(TAC) ;SAVE GOOD BITS IN LH
HRLI TAC,DSKDDB-DDBSKW ;SOURCE ADDRESS IN LH
BLT TAC,DMPBUF(DDB) ;CLEAR, INITIALIZE DDB
HRLM DDB,DEVSER+DSKDDB ;NEW LINK IN DUMMY
SETZM DEVLOG(DDB) ;CLEAR LOGICAL NAME.
PUSHJ P,DCLSDD
DPB J,[POINT 6,DEVOAD(DDB),5] ;SET JOB NUMBER
POPJ P,
↑CLRDDB: ;CALLED BY RELEASE IN UUOCON FOR RELEASE UUO.
PUSHJ P,DCLSDD
SETZB IOS,DEVIOS(DDB) ;HEAR NO EVIL
MOVEI TAC,DSKDDB ;SEARCH FOR THIS DDB
CLRDD1: MOVEI TAC1,(TAC)
HLRZ TAC,DEVSER(TAC1)
JUMPE TAC,CPOPJ ;SHOULDN'T HAPPEN
CAIE TAC,(DDB) ;RIGHT ONE YET?
JRST CLRDD1 ;NO. KEEP SEARCHING
MOVE DDB,DEVSER(TAC) ;LINK TO ONE AFTER LOSER
HLLM DDB,DEVSER(TAC1) ;SPLICE AROUND IT
SUBI TAC,DDBSKW ;CALC ADDRESS OF FREE STG BLOCK
JRST RCOR1 ;RETURN TO DISK FREE STG. AND POPJ
;CORE ALLOCATION ROUTINES
GETCOR: PUSHJ P,GCOR1 ;GET DUMP MODE COMMAND BUFFER.
MOVSM TAC,DMPBUF(DDB)
POPJ P,
GCOR1: MOVEI AC3,DDBSIZ ;SET SIZE
PUSHJ P,FSGET ;GET FREE STORAGE
JRST GCOR2 ;HAVE TO WAIT
MOVEI TAC,(AC1) ;RETURN ADDRESS IN TAC
POPJ P,
GCOR2: SUB P,[XWD 4,4] ;CALLED FROM COMMAND DECODER
JRST DLYCM1
RTNCOR: HLRZ TAC,DMPBUF(DDB) ;RELEASE DUMP MODE CMD BUFFER.
SETZM DMPBUF(DDB)
JUMPE TAC,CPOPJ ;IF NONE, LEAVE QUICK
RCOR1: HRRZ AC1,TAC ;GET ADDRESS OF BLOCK
JRST FSGIVE ;RETURN IT
;REFRES DISK REFRESHER (I. E., INITIALIZER)
↑REFRES:PUSHJ P,DQINI ;INITIALIZE SUBR QUEUE, ETC.
CONO PI,PION
MOVEI DDB,DSKDDB
MOVEI IOS,0
MOVEI DAT,SATIN ;READ IN OLD SAT TABLE.
PUSHJ P,DDOIT ;SEE TO IT.
SKIPLE TAC,BADCNT ;SEE IF ITS BAD TRACK TABLE IS BELIEVABLE.
CAILE TAC,BADMAX
JRST REF3 ;IGNORE OLD TABLE.
MOVEI TAC1,0 ;CHECKSUM OLD TABLE.
ADD TAC1,BADTRK-1(TAC)
SOJG TAC,.-1
CAMN TAC1,BADCHK
JRST REF4 ;IT CHECKS. USE IT.
REF3: SETZM BADCNT ;FLUSH OLD TABLE.
SETZM BADCHK
REF4: MOVE TAC1,TIME ;GET CURRENT TIME,
DATAI DSK,TAC ;AND CURRENT POSITION OF LIBRASCOPE..
XOR TAC,TAC1 ;..AND MAKE SHINY NEW SATID.
MOVMM TAC,SATID ;MAKE SATID ALWAYS POSITIVE.
MOVMM TAC,SATID1 ;MAKE BACKUP SATID'S RIGHT
MOVMM TAC,SATID2
SETZM LSTBLK
SETZM SATBIT
MOVE TAC,[SATBIT,,SATBIT+1]
BLT TAC,SATBIT+SATWCT ;CLEAR THE REST
MOVE TAC,MFDLOC ;PROTECT MFD IN SAT
SUBI TAC,1
IDIVI TAC,=36 ;DO THE MAPPING OURSELVES
MOVEI DAT,1 ;TO ACHIEVE UNCONDITIONLITY
MOVEM DAT,DSKUSE ;ECONOMY!
ROT DAT,(TAC1)
IORM DAT,SATBIT(TAC)
MOVEM DAT,SATCHK ;OK FOR SAT TABLE.
MOVEI DAT,SATOUT ;WRITE IT.
PUSHJ P,QENTER
PUSHACS
PUSHJ P,DISINIT ;HERE FROM ONCE, WE NEED TO INITIALIZE THIS
PUSHJ P,DISDATE
PUSHJ P,DISMES
ASCIZ /SATID=/
MOVE TAC,SATID
PUSHJ P,DISOCT
PUSHJ P,DISMES
ASCIZ / BADCNT=/
MOVE TAC,BADCNT
PUSHJ P,DISLOC
PUSHJ P,DISCRLF
SETOM DISFLAG
PUSHJ P,DISFLUSH ;FORCE ALL MESSAGES OUT
POPACS
REF2: MOVEI TEM,SYSRTV ;CONSTRUCT EMPTY MFD IN SYSBUF
HRLI TAC,MFDENT
HRRI TAC,DSKDAT(TEM)
BLT TAC,DDPRO(TEM) ;COPY NAME, EXT, PROT
MOVE TAC,SYSPPN
MOVEM TAC,DDPPN(TEM)
SETZM DDLNG(TEM)
HRLI TAC,DDLNG(TEM)
HRRI TAC,DDLNG+1(TEM)
BLT TAC,BKDSIZ+SECSIZ-1+DSKDAT(TEM) ;CLEAR THE REST
MOVE TAC,MFDLOC ;SET UP RTVL PTRS
MOVEM TAC,DDLOC(TEM)
HRLM TAC,DPTR(TEM)
AOS DGRP1R(TEM)
MOVE TAC,SATID
MOVEM TAC,DSATID(TEM) ;GIVE MFD THE SAT ID TOO
MOVE TAC,THSDAT ;DATE CREATED
HRRM TAC,DDEXT(TEM)
PUSHJ P,DSKTM1
DPB TAC,[POINT 3,DDEXT(TEM),20];RPH/DATE75
ORM TAC1,DDPRO(TEM) ;TIME LAST WRITTEN
PUSHJ P,XWSYNC ;WAIT FOR SATOUT
MOVE TAC,BUFIOW
MOVEM TAC,TFRIOW(DDB)
MOVE TAC,MFDLOC
PUSHJ P,BK2SEC
MOVEM TAC,TFRSEC(DDB)
MOVEI DAT,TSTART
DDOIT: PUSHJ P,QENTER ;MAKE REQUEST AND
XWSYNC: MOVE TAC,[XWD DEVSBB,IOACT] ; SPIN TILL DONE
TDNE TAC,DEVIOS(DDB)
JRST .-1
POPJ P,
;TIME CONTROL. INFORMATION KEPT AS FOLLOWS:
;DATE CREATED IN UFD (FILEXT) [DEC - DATE LAST WRITTEN]
;TIME LAST WRITTEN IN UFD (FILPRO) [DEC - TIME CREATED]
;TIME LAST REFERENCED IN FILE - DREFTM
;TIME LAST DUMPED IN FILE - DDMPTM
;LATTER TWO ARE ACCESSED THRU 6-WORD ENTER-LOOKUP BLOCKS IF
;DMPBIT SET BY INIT.
↑DSKTM1: ;CALLED ALSO FROM UUOCON -DSKTIM UUO
MOVE TAC,TIME
IDIVI TAC,=3600 ;JIFFIES/MIN.
HRRZ TAC1,THSDAT
DPB TAC,[POINT 11,TAC1,23]
LDB TAC,[POINT 3,THSDAT,35-12] ;EXTRA BITS IN TAC - RPH/DATE75
POPJ P, ;RETURN RESULT IN TAC1.
;DSKSTP CALLED FROM AUTORELOAD CODE IN OUTER TO PRESERVE THE SAT TABLE
↑DSKSTP:
PUSHJ P,DQINI ; CLEAR QUEUE
CONO PI,2202 ; TURN ON PI AND CH6
OSAT: MOVEI DDB,DSKDDB
PUSHJ P,CUSATO
JRST XWSYNC
ISAT: MOVEI DDB,DSKDDB ;HERE FROM ACISAT
MOVEI DAT,SATIN
PUSHJ P,NENTER
JRST XWSYNC ;WAIT FOR DISK AND RETURN
;DSKINI CALLED VIA DISPATCH FROM IOGO IN SYSINI FOR 200 RESTART.
DSKINI: PUSHJ P,DQINI
SETZM CUSLOC ;FORGET CUSLOC ON RESTARTS
PUSHJ P,ACISAT ;READ SAT TABLE
MOVE TAC,DSKDDB+DEVIOS ;GET IOS BITS
TRNE TAC,IODERR!IODTER ;DID IT WORK?
JRST NOSAT ;NO
MOVEI DDB,UDP0DD ;LINK OUT CRUFTY OLD DISK DDB'S
HRLM DDB,DSKDDB+DEVSER
MOVEI DDB,DSKDDB ;MAKE SURE WE LINK TO UDPINI
SKIPE FBACT ;SWAPPING WHERE?
POPJ P, ;ON FASTBANDS, SKIP SWAPPING PACK CRUD
PASCHK: MOVEI DDB,CAT(CAT(UDP,\<UPACKS-1>),DD)
MOVEI TAC,ASSCON!ASSPRG
IORM TAC,DEVMOD(DDB) ;ASSIGN THIS UDP
MOVE TAC,['*SWAP*']
MOVEM TAC,DEVLOG(DDB) ;ANNOUNCE THAT UDP IS USED FOR SWAPPING
SETZB TAC,DEVIOS(DDB)
DPB TAC,PJOBN ;TO JOB 0
SETZM SWPDDB ;THIS IS THE UDP WE ARE SWAPPING ON
MOVEI DAT,PASSIN ;READ PASSWORD BLOCK
PUSHJ P,NENTER
PUSHJ P,XWSYNC ;WAIT FOR IT
MOVE TAC,DEVIOS(DDB)
TRNE TAC,IODERR!IODTER!IOIMPM
JRST PASERR ;IO ERRORS OCCURED
MOVE TAC,['PASS '] ;IS IT INITIALIZED
CAMN TAC,DSKDAT(DDB)
CAME TAC,DSKDAT+1(DDB)
JRST PASOK ;NO. IT MUST BE GRUNGY PACK
SKIPE DSKDAT+2(DDB) ;PASSWORD MUST BE NULL FOR SWAPPING
JRST PAKERR ;BARF
PASOK: MOVEI DAT,PASOUT ;NOW TRY WRITING
PUSHJ P,NENTER
PUSHJ P,XWSYNC
MOVE TAC,DEVIOS(DDB)
TRNE TAC,IODERR!IODTER!IOIMPM
JRST PASERR ;POSSIBLY WRITE-LOCKED
MOVEM DDB,SWPDDB ;SAVE DDB ADDRESS FOR SWAP OPS
MOVEI DDB,DSKDDB ;SET UP DDB FOR SYSINI?
POPJ P,
DEFINE SWPMES $(XXX) < ASCIZ /SWAPPING DRIVE (UDP$XXX$) / >
PAKERR: PUSHACS
PUSHJ P,DISMES
SWPMES (\<UPACKS-1>)
PUSHJ P,DISMES
ASCIZ /WRONG PACK MOUNTED.
/
PASTRY: PUSHJ P,DISMES
ASCIZ /FIX IT. PUSH CONTINUE TO TRY AGAIN
/
SETOM DISFLAG
PUSHJ P,DISFLUSH
POPACS
HALT PASCHK ;TRY ALL OVER AGAIN
PASERR: PUSHACS
PUSH P,TAC
PUSHJ P,DISMES
SWPMES (\<UPACKS-1>) ;TELL SOMEONE WHICH UDP WE'RE USING.
POP P,TAC
TRNN TAC,IOIMPM ;OFFLINE OR WRITE-LOCK?
JRST PASIOE ;NO. REAL IO ERROR
PUSHJ P,DISMES
ASCIZ /OFF LINE OR WRITE LOCKED
/
JRST PASTRY
PASIOE: PUSHJ P,DISMES
ASCIZ /IO ERROR
/
JRST PASTRY
NOSAT: PUSHACS
MOVE TAC,[JRST AUTOLOAD] ;MAKE THEM START FROM THE FRONT
MOVEM TAC,SYSDSP
MOVEM TAC,SYSDSP+2
MOVE TAC,[XWD SYSDSP+2,SYSDSP+3]
BLT TAC,SYSDSP+7
MOVE TAC,UPTIME
MOVEM TAC,LASTRESTART ;DON'T DO A 200 RESTART
PUSHJ P,DISDATE
PUSHJ P,DISMES
ASCIZ /FAILED TO GET SAT TABLE READ IN. CHECK DISK, THEN RELOAD.
/
SETOM DISFLAG
PUSHJ P,DISFLUSH
POPACS
HALT AUTOLOAD
DQINI: SETZM UPTR ;CLEAR UDP QUEUE
SETZM QBEGIN ;INITIALIZE DISK SUBR QUEUE.
MOVSI TAC,QBEGIN
HLRZM TAC,MIPTR
HLRZM TAC,MOPTR
SETZM DQCNT ;NUMBER OF TASKS IN DISK QUEUE
HRRI TAC,QBEGIN+1
BLT TAC,LOGEND ;CLEAR OUT REQUEST QUEUE
PUSHJ P,DISKUP ;MAKE IBM LISTEN TO US
IJOB: SETZM DFBUSY
SETZM SQREQ
HLLZS IOPCON
SETZM DXB
SETZM DSKEDD
SETZM ERRBIT
SETZM DSKERB
SETZM BKIN
POPJ P,
ACISAT: CONO PI,PION ;CERTAINLY ISN'T ON YET
SKIPN SATMOD ;READ IF -1.(FIRST TIME ONLY)
JRST OSAT ;ELSE WRITE (POPJ FROM OSAT)
MOVE TAC,SATID ;MAKE SURE COPIES OF SATID AGREE
MOVEM TAC,SATID1
MOVEM TAC,SATID2
PUSHJ P,ISAT ;GET SAT IN
MOVE TAC,SATID ;NOW COPY GOOD SATID
MOVEM TAC,SATID1
MOVEM TAC,SATID2
MOVE TAC,[POINT 1,SATBIT] ;PREPARE TO COUNT SAT BITS!
MOVEI TAC1,(LSTBIT+43)/44*44 ;NUMBER OF BITS IN TABLE ROUNDED TO WORD BOUNDARY
SETZB AC1,SATMOD ;NUMBER OF BITS ON SO FAR.
;WRITE SAT FROM NOW ON
ILDB AC2,TAC ;LOAD A BIT
ADDI AC1,(AC2) ;SEE THE CLEVER PROGRAMMER COUNT BITS
SOJGE TAC1,.-2 ;COUNT THEM ALL
MOVEM AC1,DSKUSE ;SET HONEST DSKUSE
SKIPG AC2,BADCNT ;ANY BAD TRACKS TO TURN ON?
POPJ P,
CAILE AC2,BADMAX
MOVEI AC2,BADMAX
SETZM BADCHK
MRKITB: MOVE TAC,BADTRK(AC2)
ADDM TAC,BADCHK ;ACCUMULATE CHECKSUM
PUSHJ P,MRKBLK ;MARK BAD TRACK SO IT WON'T GET USED
SOJG AC2,MRKITB
POPJ P,
; BUFFERED I/O
;BUFFERED INPUT
DBUFI: TLNN IOS,READB!WRITEB!ALTERB
JRST ENOLUK ;NO LOOKUP
TRNE IOS,IODERR!IODTER ;ERROR LAST TIME?
POPJ P, ;YES
TLNE IOS,LOSBIG ;BAD RETRIEVAL?
JRST EGARB ;YES PRINT MESSAGE
MOVSI IOS,IO
ANDCAB IOS,DEVIOS(DDB) ;MARK AS READING
JSP AC1,TSTEOF ;RETURN NOW IF PAST EOF
JRST DIEOF
MOVEI DAT,DIBUFI
PUSHJ P,QENTER ;QUEUE TASK. USER PGM CAN PROCEED
POPJ P,
TSTEOF: MOVE TAC,USETP(DDB) ;GET USET POINTER
SUBI TAC,1
ASH TAC,RECWSH ;RECORD NUMBER * 200 = WORD NUMBER
CAMGE TAC,FILLNG(DDB) ;PAST EOF?
JRST 1(AC1) ;NO. OK TO READ MORE
JRST (AC1) ;PAST EOF
;***INTERRUPT SUBR***
DIBUFI: PUSHJ P,GETBLK ;GET BLOCK INTO SYSBUF
JUMPE TAC,SETLOS ;NON EX = BAD RETRIEVAL
PUSHJ P,AUDCHK ;DID WE GET THE RIGHT FILE?
DIBFI1: MOVE TAC,USETP(DDB)
SUB TAC,DGRP1R(DDB)
IDIVI TAC,RCPBLK
ASH TAC1,RECWSH ;7
HRRZ TAC,DEVIAD(DDB) ;GET REL. ADDR. OF USER BUFFER
HLRZ DAT,PROG
CAIG TAC,(DAT) ;ILL. ADR.?
JRST DIBFI3 ;NO, RELOCATE BY PROG
LDB DAT,PSEGN ;YES, CHECK FOR UPPER SEGMENT
HRRZ DAT,JBTADR(DAT)
ADDI TAC,-400000(DAT)
JRST DIBFI4
DIBFI3: ADDI TAC,(PROG) ;RELOCATE INTO LOWER
DIBFI4: HRLI DAT,SYSDTA(TAC1)
HRRI DAT,2(TAC)
BLT DAT,RECSIZ+1(TAC) ;INTO USER'S BUFF
AOS TAC1,USETP(DDB)
SUBI TAC1,1
ASH TAC1,RECWSH
SUB TAC1,FILLNG(DDB)
MOVEI DAT,RECSIZ ;SET UP WORD COUNT
JUMPL TAC1,DIBFI2 ;IF NOT PAST EOF
TLO IOS,IOEND ;EOF; TELL USER
SUB DAT,TAC1 ;ADJUST WORD COUNT
DIBFI2: HRRM DAT,1(TAC) ;GIVE WD CT TO USER.
PUSHJ P,ADVBFF
POPJ P, ;NO MORE BUFFERS EMPTY.
TLNE IOS,IOEND ;QUIT IF END OF FILE
POPJ P,
MOVE TAC,USETP(DDB)
SUB TAC,DGRP1R(DDB)
IDIVI TAC,RCPBLK
JUMPN TAC1,DIBFI1 ;DO MORE IF BLK NOT DONE
POPJ P, ;QUIT.
DIEOF: TLO IOS,IOEND
JRST DSIOS ;STORE IOS, AND POPJ.
;BUFFERED OUTPUT
DBUFO: TLNN IOS,WRITEB!ALTERB
JRST ENOENT
MOVSI IOS,IO
IORB IOS,DEVIOS(DDB) ;FLAG OUTPUT FOR UUOCON
TLNE DDB,OCLOSB ;CALLED BY CLOSE?
JRST DBUFO1 ;YES, DO OUTPUT NOW
DBUFOA: TRNE IOS,IODERR!IODTER ;ERROR RECENTLY
POPJ P, ;YES, TELL HIM
TLNE IOS,LOSBIG ;OR BAD RETRIEVAL
JRST EGARB ;YES
HLR TAC,DEVBUF(DDB) ;PTR TO OBUFF HDR
XCTR XR,[HRR TAC,(TAC)] ;GET PTR TO NEXT FREE BFR
XCTR XR,[SKIPL TAC1,(TAC)]
JRST DBFOGO ;NEXT BUFFER IS FREE.
TRNN IOS,IOACT ;NEXT BUFFER IS FULL.
PUSHJ P,DBUFO1 ;IF NOT ACTIVE, START OUTPUT.
PUSHJ P,WSYNC ;WAIT FOR OUTPUT TO HAPPEN.
JRST DBUFOA ;RETURN OR START NEXT OUTPUT.
DBFOGO: XCTR XR,[SKIPGE (TAC1)] ;CHECK ONE AFTER.
TRNE IOS,IOACT ;IT'S FULL, OUTPUT ALREADY GOING?
POPJ P, ;YES, LET USER RUN.
DBUFO1: PUSHJ P,MAKBLK ;ENTER A TRANSFER IN QUEUE.
MOVEI DAT,DIBUFO ;CALL INT LEVEL SUBR
PUSHJ P,QENTER ;USER PGM CAN PROCEED
POPJ P,
;*** INTERRUPT SUBR ***
DIBUFO: MOVE TAC,USETP(DDB) ;LOAD SYSBUF & OUTPUT
MOVEM TAC,DSKFAD(DDB)
SUB TAC,DGRP1R(DDB)
IDIVI TAC,RCPBLK
ASH TAC1,RECWSH
MOVEI TAC,SYSDTA(TAC1) ;DATA AREA OF SYSBUF
MOVEM TAC,CORFAD(DDB)
MOVEM TAC,CORLAD(DDB)
DIBFO1: HRRZ TAC,DEVOAD(DDB)
HLRZ TAC1,PROG
CAIG TAC,(TAC1)
JRST DIBFO2
LDB TAC1,PSEGN
HRRZ TAC1,JBTADR(TAC1)
ADDI TAC,-400000+2(TAC1)
JRST DIBFO3
DIBFO2: ADDI TAC,2(PROG)
DIBFO3: SKIPG AC1,-1(TAC) ;ANY WORDS IN THIS BUFFER
JRST DIBFO4 ;NO, SKIP OVER IT
MOVSS TAC
HRR TAC,CORLAD(DDB)
MOVEI TAC1,RECSIZ(TAC)
MOVEM TAC1,CORLAD(DDB)
BLT TAC,-1(TAC1) ;COPY USRBUF TO SYSBUF
AOS USETP(DDB)
PUSHJ P,ADVBFE
JRST DIBOFT ;NO MORE BUFFERS READY
MOVE TAC,USETP(DDB)
SUB TAC,DGRP1R(DDB)
IDIVI TAC,RCPBLK
JUMPN TAC1,DIBFO1 ;BLOCK NOT DONE, DO MORE
DIBOFT: MOVE TAC,CORFAD(DDB) ;PICK UP STARTING ADDRESS
CAML TAC,CORLAD(DDB) ;BEFORE FINISHING ADDRESS
POPJ P, ;NO, NOTHING TO DO.
MOVE TAC,USETP(DDB) ;DID FILE GROW?
SUBI TAC,1+1 ;-1 FOR AOS ABOVE, -1 FOR LAST RECORD,
ASH TAC,RECWSH ;WHICH WILL BE COUNTED BY WC BELOW
CAILE AC1,RECSIZ
MOVEI AC1,RECSIZ ;AVOID BUMPING WC BY TOO MUCH
ADDI TAC,(AC1) ;ADD WC FROM LAST RECORD WRITTEN
CAMG TAC,FILLNG(DDB)
JRST DIBOFW ;NO, GO DO OUTPUT.
MOVEM TAC,FILLNG(DDB) ;YES, MARK IT SO
; MOVEI TAC,1
; CAME TAC,DGRP1R(DEVDAT) ;IF BEYOND FIRST GROUP,
; TLOA IOS,HDRDIF!PNTDIF ;UPDATE RTVL AT CLOSE.
TLO IOS,PNTDIF!HDRDIF
DIBOFW: MOVE TAC,CORFAD(DDB) ;IF RTVL NOT CONTIGUOUS,
CAIN TAC,SYSDTA ;CAN'T WRITE IT NOW.
TLNN IOS,PNTDIF
JRST DIBOFN ;UPDATING RTVL NOT RQD
PUSHJ P,AUDINF
HRLI TAC,DSKDAT(DDB) ;BLT RTVL FROM DDB...
HRRI TAC,SYSBUF ;TO SYSBUF
BLT TAC,SYSDTA-1
; PUSHJ P,SPREDT ;FIRST UPDATE PRIOR RTVL.
MOVE TAC,DSKFAD(DDB) ;SET UP TRANSFER
PUSHJ P,LR2BLK
JUMPE TAC,SETLOS ;NON EX = BAD RETRIEVAL
PUSHJ P,BK2SEC
MOVEM TAC,TFRSEC(DDB)
MOVE TAC,CORFAD(DDB)
SUB TAC,CORLAD(DDB)
ADD TAC,[SYSBUF,,-40]
MOVSM TAC,TFRIOW(DDB) ;WRITE ONLY THE RETRIEVAL AND VALID DATA
JRST RERITE ;GO DO OUTPUT.
DIBOFN: MOVE TAC,CORFAD(DDB) ;HERE IF RTVL IS OUT
SUB TAC,CORLAD(DDB) ;GET -WORD COUNT
HRL TAC,CORFAD(DDB)
MOVSM TAC,TFRIOW(DDB)
MOVE TAC,DSKFAD(DDB) ;STARTING RECORD NO.
PUSHJ P,LR2BLK
JUMPE TAC,SETLOS ;NON EX = BAD RETRIEVAL
PUSHJ P,BKMAP
MOVEM TAC,TFRSEC(DDB)
RERITE: MOVEI TAC,DWRITE!IOPCHN
MOVSM TAC,TFRCTL(DDB)
PUSHJ P,TSTART ;WRITE OUT DATA
POPJ P,
SETLOS: TDO IOS,[LOSBIG!IOEND,,IODEND] ;SCREW THE BASTARD
JRST DSIOS ;STO IOS AND GO UP ONE LEVEL
DIBFO4: PUSHJ P,ADVBFE ;ADVANCE THE BUFFERS
JRST DIBOFT ;NONE LEFT, DO TRANSFER IF ANY WORDS TO TRANSFER
JRST DIBFO1 ;LOOK AT ANOTHER BUFFER
; DUMP MODE I/O
;COMMAND LIST IN IOWD FORMAT: (-WDCT)SA-1
;GETS CONVERTED TO 167 FORMAT: (-WDCT)SA
; RETURNS STARTING ADDRESS IN TAC1 AND -WD CT IN TAC
↑DMPCMD:
MOVEI AC1,JOBPFI ;LOWER LIMIT
MOVE TAC,UUOPC(J)
TLNN TAC,USRMOD ;MONITOR OP?
MOVEI AC1,JOBSAV ;YES
HLRZ AC2,PROG ;UPPER LIMIT=PROTECTION
LDB AC3,PSEGN
JUMPE AC3,DMPGET ;AC3 ← HIGH SEGEMENT PROTECT ADDR
HLRZ AC3,JBTADR(AC3)
ADDI AC3,400000 ;UPPER SEGMENT ADDRESSES ARE O.K.
DMPGET:
DMPGT1: XCTR XR,[SKIPN TAC1,(UUO)] ;GET NEXT COMMAND WORD
JRST TPOPJ ;ZERO TERMINATES
DMPGT2: HLRE TAC,TAC1 ;NEGATIVE WORD COUNT
ANDI TAC1,-1 ;FIRST ADDRESS-1
JUMPE TAC,DMPTCH ;JUMP IF THIS IS A JUMP COMMAND
ADDI TAC1,1 ;REAL STARTING ADDRESS
CAIGE TAC1,(AC1) ;ABOVE MINUMUM PROTECT ADDRESS?
JSP DAT,ADRERR ;NO. LOSE.
PUSH P,TAC1 ;SAVE STARTING ADDRESS
HRRO TAC,TAC ;IN CASE HUGE WD CT
SUB TAC1,TAC ;CALCULATE LAST ADDR
CAIG TAC1,1(AC2) ;IS IT WITHIN LOWER?
JRST T1POPJ ;YES. WIN.
CAIG TAC1,1(AC3) ;BENEATH TOP OF UPPER?
TRNN TAC1,400000 ;YES. IN UPPER AT ALL.
JSP DAT,ADRERR ;NO TO ONE OF ABOVE
T1POPJ: POP P,TAC1 ;GET STARTING ADDRESS BACK
POPJ P, ;WIN
DMPTCH: HRR UUO,TAC1 ;SET ADDRESS OF NEXT COMMAND
CAIG TAC1,(AC1) ;ABOVE PROTECTED AREA?
JSP DAT,ADRERR ;NO. LOSE
CAIG TAC1,(AC2) ;ADDRESS OK?
JRST DMPGET ;YES.
CAIG TAC1,1(AC3) ;BENEATH TOP OF UPPER?
TRNN TAC1,400000 ;YES. IN UPPER AT ALL?
JSP DAT,ADRERR ;NO TO ONE OF ABOVE
JRST DMPGET
DDCALC: MOVE AC1,USETP(DDB) ;LOCATE END OF BLOCK
ADDI AC1,RCPBLK-1 ;CONTAINING USETP
MOVEI DAT,RCPBLK
IDIVM AC1,DAT ;SEE US CLEVERLY AVOID A REMAINDER !
IMULI DAT,RCPBLK
LSH DAT,RECWSH ;CONVERT TO WORD COUNT.
POPJ P,
;DUMP MODE INPUT
DDMPI: TLNN IOS,READB!WRITEB!ALTERB
JRST ENOLUK
JSP AC1,TSTEOF ;SEE IF IMMEDIATE EOF
JRST DDMIEF ;YES. TELL LOSER.
TLZ IOS,IO ;FLAG INPUT
TLO IOS,GOBIT ;MAKE US UNSTOPPABLE.
MOVEM IOS,DEVIOS(DDB)
PUSHJ P,DDICOM
DDXIT: PUSHJ P,RTNCOR ;RETURN COMMAND BUFFER TO FREE STG
TRNN IOS,IODERR!IODTER ;IF DATA OR DEVICE ERROR, LET USER SEE IT!
TLNN IOS,LOSBIG ;ELSE IF BAD RETRIEVAL PRINT MESSAGE
JRST DPOPJ
JRST EGARB
DDICOM: PUSHJ P,GETCOR ;GET CORE FOR COMMAND LIST NOW
PUSHJ P,GETRET ;GET GROUP DIRECTORY
JRST SETLOS ;BAD RETRIEVAL
DDICO2: PUSHJ P,DMPCMD ;GET AN IOWD
MOVEM TAC1,CORFAD(DDB) ;SAVE STARTING ADDRESS
MOVE AC1,USETP(DDB)
SUBI AC1,1
ASH AC1,RECWSH ;7
MOVEM AC1,DSKFAD(DDB)
SUB AC1,TAC ;CALC DISK LAST ADDR
CAMG AC1,FILLNG(DDB)
JRST DDICO3
TLO IOS,IOEND
MOVE AC1,FILLNG(DDB) ;STOP AT EOF
DDICO3: MOVEM AC1,DSKLAD(DDB)
DDIC0: HLRS DMPBUF(DDB)
DDIC1: PUSHJ P,DDCALC ;FIND BLOCK END.
CAMLE DAT,DSKLAD(DDB) ;COMPARE WORD COUNTS.
MOVE DAT,DSKLAD(DDB)
SUB DAT,DSKFAD(DDB) ;THIS GIVES TFR WORD COUNT.
MOVN TAC,DAT
HRR TAC1,CORFAD(DDB)
HLRZ TEM,PROG
CAIG TAC1,(TEM)
JRST DDIC2
LDB TEM,PSEGN
HRRZ TEM,JBTADR(TEM)
TRZ TAC1,400000 ;FOR 256K IT MUST BE DONE-RPH 4-17-72
ADDI TAC1,(TEM)
JRST DDIC3
DDIC2: ADDI TAC1,(PROG) ;RELOCATE
DDIC3: HRL TAC1,TAC ;PUT IN -WD COUNT
AOS TEM,DMPBUF(DDB)
MOVEM TAC1,-1(TEM) ;ENTER IN COMMAND LIST
ADDM DAT,CORFAD(DDB) ;BUMP FIRST ADDR BY WD CT
ADDB DAT,DSKFAD(DDB)
ADDI DAT,RECSIZ+RECSIZ-1 ;ROUND UP TO RECORD
ASH DAT,-RECWSH
MOVE TAC,USETP(DDB)
MOVEM DAT,USETP(DDB)
PUSHJ P,LR2BLK
JUMPE TAC,SETLOS ;NON EX = BAD RETRIEVAL
PUSHJ P,BKMAP
MOVEM TAC,(TEM)
AOS TEM,DMPBUF(DDB) ;BUMP COMMAND POINTER
HLRZ TAC,TEM ;END CHECK COMMAND LIST
CAIGE TAC,-100(TEM)
JRST EDMPLS ;ILL FMT COMMAND LIST.
MOVE TAC,DSKFAD(DDB)
CAME TAC,DSKLAD(DDB) ;SEE IF REQUEST COMPLETED
PUSHJ P,TSTRET ;START XFER IF GRP OFLOW
JRST DDIGO ;RTVL NOT IN MEANS GRP OFLOW
JRST DDIC1 ;NO OFLOW YET, DO MORE
DDIGO: MOVEI DAT,DIDMPI ;START I-LEVEL SUBR
PUSHJ P,QEWAIT
TRNE IOS,IODERR!IODTER ;IF DEVICE SCREW-UP
POPJ P, ;QUIT NOW!
MOVE TAC,DSKFAD(DDB)
CAME TAC,DSKLAD(DDB)
JRST DDIC0 ;WORDS LEFT; DO ANOTHER GROUP
TLNN IOS,IOEND ;END FILE?
AOJA UUO,DDICO2 ;NO, DO NEXT IOWD
DDMIEF: IOR IOS,[XWD IOEND,IODEND]
JRST DSIOS ;STORE IOS, AND POPJ.
;*** INTERRUPT SUBR ***
DIDMPI: MOVE TEM,DMPBUF(DDB)
HLRS TEM
MOVEI TAC1,IOPCHN
MOVSM TAC1,TFRCTL(DDB)
DIDMI1: MOVE TAC1,(TEM) ;WCMA FROM COMMAND LIST
MOVEM TAC1,TFRIOW(DDB)
MOVE TAC1,1(TEM)
MOVEM TAC1,TFRSEC(DDB)
PUSHJ P,TSTART
ADDI TEM,2
CAMGE TEM,DMPBUF(DDB)
JRST DIDMI1
DIDMI2: MOVE TAC,DSKFAD(DDB)
CAMN TAC,DSKLAD(DDB) ;IF LAST TFR,JUST RETURN
POPJ P,
SKIPN TAC,DNXTGP(DDB) ;ELSE GET RTVL FOR NEXT GRP.
JRST DMIEF1 ;FLAG END
PUSHJ P,BK2SEC
MOVEM TAC,TFRSEC(DDB)
MOVEI TAC,DSKDAT(DDB) ;READ RIGHT INTO DDB
HRLI TAC,-SECSIZ
MOVEM TAC,TFRIOW(DDB)
PUSHJ P,TSTART
PUSHJ P,AUDCHK
POPJ P,
DMIEF1: TLO IOS,IOEND
POPJ P,
;DUMP MODE OUTPUT
DDMPO: TLNN IOS,WRITEB!ALTERB
JRST ENOENT
TLO IOS,IO!GOBIT ;FLAG OUTPUT
MOVEM IOS,DEVIOS(DDB)
PUSHJ P,DDOCOM
JRST DDXIT
DDOCOM: PUSHJ P,GETCOR ;GET BUFFER FOR COMMAND LIST
DDOCO2: PUSHJ P,DMPCMD ;GET IOWD
MOVEM TAC1,CORFAD(DDB)
MOVE AC1,USETP(DDB)
SUBI AC1,1
ASH AC1,RECWSH
MOVEM AC1,DSKFAD(DDB)
SUB AC1,TAC ;TAC: -WD CT
MOVEM AC1,DSKLAD(DDB)
CAMG AC1,FILLNG(DDB) ;DID FILE GROW?
JRST DDOC0
MOVEM AC1,FILLNG(DDB)
TLO IOS,HDRDIF ;INDICATE NEW FILLNG TO SPREAD.
MOVEM IOS,DEVIOS(DDB) ;GET IT INTO THE DDB
DDOC0: HLRS DMPBUF(DDB)
DDOC1: PUSHJ P,MAKBLK
JUMPE TAC,SETLOS ;NON EX = BAD RETRIEVAL
PUSHJ P,DDCALC ;LOCATE BLOCK'S END.
CAMLE DAT,DSKLAD(DDB) ;COMPARE WORD COUNTS.
MOVE DAT,DSKLAD(DDB)
SUB DAT,DSKFAD(DDB) ;THIS GIVES TFR WORD COUNT.
MOVN TAC,DAT
HRR TAC1,CORFAD(DDB)
HRL TAC1,TAC ;PUT IN -WD COUNT
AOS TEM,DMPBUF(DDB)
MOVEM TAC1,-1(TEM) ;ENTER IN COMMAND LIST
ADDM DAT,CORFAD(DDB) ;UPDATE STARTING ADDRESSES
ADDB DAT,DSKFAD(DDB)
ADDI DAT,RECSIZ+RECSIZ-1
ASH DAT,-RECWSH
MOVE TAC,USETP(DDB)
MOVEM DAT,USETP(DDB)
PUSHJ P,LR2BLK
JUMPE TAC,SETLOS ;NON EX = BAD RETRIEVAL
PUSHJ P,BKMAP
MOVEM TAC,(TEM)
AOS TEM,DMPBUF(DDB)
HLRZ TAC,TEM
CAIGE TAC,-100(TEM) ;END CHK COMND LIST
JRST EDMPLS ;ILL FMT COMMAND LIST.
MOVE TAC,DSKFAD(DDB)
CAMN TAC,DSKLAD(DDB) ;ALL WORDS ACCOUNTED FOR?
JRST DDMPO4 ;YES, DO OUTPUT
PUSHJ P,TSTRET ;RTVL NOT IN MEANS GRP OFLOW
JRST DDMPO3 ;GRP OFLOW, DO OUTPUT
JRST DDOC1 ;NO OFLOW, DO NEXT BLOCK
DDMPO3: SKIPE DNXTGP(DDB) ;NEXT GROUP EXIST?
JRST DDMPO4 ;YES, OUTPUT THIS BLOCK.
PUSHJ P,ASNGRP ;NO, SET IT UP.
DDMPO4: MOVEI DAT,DIDMPO ;WRITE THIS GROUP OUT.
PUSHJ P,QEWAIT
TRNE IOS,IODERR!IODTER
POPJ P, ;QUIT NOW IF ERROR!
MOVE TAC,DSKFAD(DDB)
CAME TAC,DSKLAD(DDB)
JRST DDOC0 ;WORDS LEFT, DO ANOTHER GROUP
AOJA UUO,DDOCO2 ;GET NEXT IOWD
;***INTERRUPT SUBR***
DIDMPO: TLZE IOS,PNTDIF
PUSHJ P,SPREAD
MOVE TEM,DMPBUF(DDB)
HLRS TEM
MOVEI TAC1,DWRITE!IOPCHN
MOVSM TAC1,TFRCTL(DDB)
DIDMO1: MOVE TAC1,(TEM)
HLRZ DAT,PROG
CAIL DAT,(TAC1)
JRST DIDMO2
LDB DAT,PSEGN
TRZ TAC1,400000 ;BELIEVE ME FRED THIS IS THE ONLY WAY!
HRRZ DAT,JBTADR(DAT) ;RPH 4-17-72
ADDI TAC1,(DAT) ;RELOCATE TO UPPER
JRST DIDMO3
DIDMO2: ADDI TAC1,(PROG)
DIDMO3: MOVEM TAC1,TFRIOW(DDB)
MOVE TAC1,1(TEM)
MOVEM TAC1,TFRSEC(DDB)
PUSHJ P,TSTART
ADDI TEM,2
CAMGE TEM,DMPBUF(DDB)
JRST DIDMO1
POPJ P,
;BOTH INPUT & OUTPUT CLOSE ARE ALWAYS CALLED FROM UUOCON.
;CLOSE INPUT.
DCLOSI: TLNE IOS,IOSET
JRST DSIOS ;FAKE FOR USETI, RETURN.
TLZE IOS,READB
TLZN IOS,DELETB ;DELETE FILE (SUBSEQUENT ENTER)?
JRST DSIOS ;NO, JUST RETURN.
JSP AC1,ACCESS ;IS ANYONE ELSE READING?
JRST DSIOS ;YES, DON'T DELETE.
JFCL ;IRRELEVANT
PUSHJ P,GOSET ;MAKE US UNSTOPPABLE.
MOVE TAC,FILLOC(DDB) ;NO ONE ELSE LOOKING, SO...
PUSHJ P,DELETE ;DELETE FILE.
PUSHJ P,CUSATO ;OUT SAT IF NEEDED.
PUSHJ P,WSYNC ;WAIT FOR IT
JRST DPOPJ
;CLOSE OUTPUT
DCLOSO: TLNN IOS,WRITEB!ALTERB
JRST DCLSDD ;NO ENTER, BLAST DDB
PUSHJ P,GOSET
TLNN DDB,OUTBFB+OUTPB ;ANY OUTPUT BUFFERS SET UP?
JRST DCLSO3 ;NO. NOTHING TO FLUSH --ME
LDB TAC,PIOMOD ;#-EATING APRSER SHOULD DO THIS
CAIGE TAC,DR
PUSHJ P,OUT ;LAST OUTPUT FOR BUFFERED MODES
DCLSO3: PUSHJ P,WAIT1 ;FINISH IT
TLNE IOS,IOSET ;WERE WE CALLED FROM USETO?
JRST DPOPJ ;YES. CLEAR GOBIT AND RETURN.
MOVEI DAT,DCLOI
TLNE IOS,PNTDIF!HDRDIF ;RTVL CORRECT?
PUSHJ P,NEWAIT ;NO, GO FIX
PUSHJ P,RTNCOR ;IF OUTPUT ABORTED
;FILE & POINTERS NOW OUT; FIX UP UFD
DCLSO1: TLNN IOS,NTRUFD ;CHANGE UFD?
JRST DCLSO2 ;NO, NEW FILE; UFD POINTS TO IT
DCLSO9: TLZ IOS,DELETB ;NEW VERSION OF OLD FILE.
MOVSI AC2,DELETB
JSP AC1,ACCESS ;MARK READERS OF OLD FILE...
JRST DCLSOR ;TO DELETE IT WHEN THRU
JRST ELOSE ;SHOULD BE JUST US WRITING
PUSHJ P,UFDSRC ;GET UFD RTVL
MOVEI DAT,DRAUFD ;USE RENAME CODE TO...
PUSHJ P,QEWAIT ;CHANGE UFD TO NEW FILE
TLZE IOS,DELETB ;WAS ANYONE READING?
JRST DCLSO2 ;YES, DON'T DELETE NOW
DCLSOC: MOVE TAC,SRCLOC(DDB) ;OLD FILE LOCATION
DCLSOD: PUSHJ P,DELETE ;DELETE IT
DCLSO2: PUSHJ P,CUSATO ;OUT SAT IF NEEDED
PUSHJ P,WSYNC ;WAIT FOR IT
DCLSDD: TDNE IOS,[XWD DEVSBB,IOACT]
SETZB IOS,DEVIOS(DDB) ;THIS SHOULDN'T HAPPEN, BUT IT DOES.
MOVSI TAC,DEVIBF
ANDCAM TAC,DEVCMR(DDB)
PUSHJ P,RTNCOR
SETZM ACCNAM(DDB)
HRLI TAC,ACCNAM(DDB)
HRRI TAC,ACCNAM+1(DDB)
BLT TAC,DDEND-1(DDB)
ANDI IOS,GARBIT!DMPBIT!17
JRST DPOPJ
DCLSOR: IORM AC2,DEVIOS(TAC) ;FOUND READER, MARK TO DELETE
TLO IOS,DELETB ;FLAG FILE STILL IN USE
JRST ACCES1 ;KEEP LOOKING
; *** INTERRUPT LEVEL ROUTINE ***
; UPDATE FIRST RTVL (LENGTH) &∨ LAST (PTRS).
DCLOI: TLZN IOS,HDRDIF ;HEADER PTRS OK?
JRST DCLSO5 ;YES, FIX LAST PTRS
MOVEI TAC,1 ;HEADER IS WRONG
CAMN TAC,DGRP1R(DDB) ;LOOKING AT HEADER?
JRST DCLSO5 ;YES, GO FIX IT
; TLNN IOS,PNTDIF ;LAST POINTERS OK?
PUSHJ P,DCLSO5 ;NO, FIX THEM TOO
MOVEI TAC,1
MOVEM TAC,USETP(DDB)
PUSHJ P,GGRETI ;GET HEADER POINTERS
DCLSO5: PUSHJ P,AUDINF ;FIX UP
DCLSO4: PUSHJ P,SPREAD ;OUTPUT POINTERS
TLNE IOS,HDRDIF ;WERE BLOCKS REASSIGNED AT INTERRUPT LEVEL?
JRST DCLOI ;YES.
POPJ P,
;RELEASE UUO, CALL RESET, AND CALL EXIT
DRELES: PUSHJ P,WAIT1 ;MAKE SURE RESET WAITS FOR DISK TO STOP
PUSHJ P,DCLOSI ;MAYBE DELETE FILE WE READ.
TLNN IOS,WRITEB ;IS A PARTIALLY WRITTEN FILE?
JRST DCLSDD ;NO, CLEAR DDB.
PUSHJ P,GOSET ;WE GET HERE ON RESET ONLY.
MOVEI DAT,DCLOI ;MAKE SURE RETRIEVAL IS OUT.
PUSHJ P,QEWAIT
MOVE TAC,FILLOC(DDB)
TLNE IOS,NTRUFD
JRST DCLSOD ;OLD FILE EXISTS, DELETE NEW
PUSHJ P,UFDSRC ;NEW FILE, DELETE NAME
SETZM ACCNAM(DDB)
MOVEI DAT,DRAUFD
PUSHJ P,QEWAIT
JRST DCLSOC ;THEN DELETE FILE.
;USETI, USETO, UGETF.
DSETI: TLNN IOS,READB
JRST ENOLUK
PUSH P,UUO ;SAVE THIS FOR LATER
HRRI UUO,CLSOUT ;DON'T AFFECT OUTPUT
DSETC0: PUSHJ P,DSETC ;FLUSH BUFFERS, FINISH IO
POP P,TAC1
HRRE TAC1,TAC1
ADD TAC1,DOFFST(DDB) ;ADD OFFSET
SKIPG TAC1 ;IF LESS THAN 1
MOVEI TAC1,1 ;MAKE IT 1 (LOSERS)
PUSHJ P,DGETL ;GET RECORD EOF+1
CAMLE TAC,TAC1 ;SET TO END IF NOT IN FILE
SKIPA TAC,TAC1 ;IT'S OK - USE IT
DSETC1: TDOA IOS,[XWD IOEND,IODEND] ;OFF END
TDZ IOS,[XWD IOEND,IODEND] ;INSIDE FILE, NO EOF
MOVEM TAC,USETP(DDB) ;STORE NEW POINTER
TLNE IOS,WRITEB!ALTERB ;COULD HE BE WRITING?
SKIPN TAC1,DGRP1R(DDB) ;AND DO WE HAVE ANY RETRIEVAL?
JRST DSIOS ;NOTHING TO DO
CAIGE TAC,RCPGRP(TAC1)
CAIGE TAC,(TAC1) ;IS NEW RECORD IN CURRENT RETRIEVAL?
TLZN IOS,PNTDIF ;NO, POINTERS NEED UPDATE?
JRST DSIOS ;NO UPDATE!
MOVEI DAT,DCLSO5
PUSHJ P,NEWAIT ;GO
JRST DSIOS ;STO IOS AND RETURN
DSETO: TLNN IOS,WRITEB!ALTERB
JRST ENOENT
PUSH P,UUO
HRRI UUO,CLSIN ;LEAVE INPUT ALONE
JRST DSETC0
DGETF: PUSH P,UUO
MOVEI UUO,CLSIN!CLSOUT
TLNE IOS,READB
TRZ UUO,CLSIN
TLNE IOS,WRITEB!ALTERB
TRZ UUO,CLSOUT
PUSHJ P,DSETC ;FLUSH BUFFERS, FINISH IO
POP P,UUO
PUSHJ P,DGETL ;NOW GET END OF FILE
MOVE TAC1,TAC ;SAVE COPY
SUB TAC1,DOFFST(DDB) ;UN-OFFSET FOR LOSER
XCTR XRW,[HRRM TAC1,(UUO)] ;GIVE TO USER
JRST DSETC1 ;AND USETP TO THERE
DGETL: MOVE TAC,FILLNG(DDB) ;FIND NEXT FREE RECORD
↑DGETL1:ADDI TAC,RECSIZ-1 ;ROUND UP TO NEXT FULL RECORD
ANDCMI TAC,RECSIZ-1
ASH TAC,-RECWSH
ADDI TAC,1
POPJ P,
DSETC: MOVSI IOS,IOSET ;FLAG FOR CLOSE
IORB IOS,DEVIOS(DDB) ;FOR WAIT1 AT CLSOUT (UUOCON)
PUSH P,DDB
PUSHJ P,CLOSE1 ;TO FLAG BUFFERS EMPTY.
POP P,DDB ;RE-OPEN
TLZ IOS,IOSET ;MAKE SURE THIS IS OFF!
MOVEM IOS,DEVIOS(DDB)
HLLM DDB,USRJDA(UCHN) ;AND REPLACE IN USER TABLE
POPJ P,
;MTAPE UUO -- BY R. HELLIWELL -- 16 JAN 72
; IF FIRST WORD = SIXBIT/GODMOD/ :
; THEN SECOND WORD IS DISPATCH INTO GODDIS
; SEE ROUTINE FOR FURTHER DESCRIPTION
;
; ANYTHING ELSE IN FIRST WORD GETS THE USET POINTER!
DGETW: PUSHJ P,WAIT1 ;FINISH ANYTHING IN PROGRESS
XCTR XR,[MOVE TAC,(UUO)] ;PICK UP FIRST ARG!!!
CAMN TAC,[-1] ;OLD MTAPE?
JRST UUOERR ;YES: OLD FORM OF MTAPE NO LONGER EXISTS
CAME TAC,['GODMOD'] ;REQUESTING NEW GOD MODE
JRST GETPNT ;NO. GET THE USET POINTER
ADDI UUO,1
XCTR XR,[MOVE TAC,(UUO)]
CAIL TAC,GODLEN ;OFF END OF TABLE?
JRST UUOERR ;YES, TELL HIM HE LOST
SKIPL GODDIS(TAC) ;PROTECTED MTAPE?
JRST @GODDIS(TAC) ;NO, DISPATCH
MOVE TAC1,JBTPRV(J) ;YES, CHECK PRIV.
TLNN TAC1,INFPRV ;USE THIS PRIVILEGE
JRST UUOERR ;LOSER
JRST @GODDIS(TAC)
;IF SIGN BIT ON IN TABLE, MUST HAVE INFPRV TO DO THIS UUO!!!!!!!!
GODDIS: GETPNT ;0 GET USET POINTER
400000,,GDREAD ;1 READ DISK BLOCK
GDWRIT ;2 WRITE DISK BLOCK
SETSAT ;3 SET SAT BIT
CLRSAT ;4 CLEAR SAT BIT
SATRD ;5 READ WORDS FROM SAT TABLE
SATWRT ;6 WRITE WORDS IN SAT TABLE
SATFRC ;7 FORCE OUT SAT
400000,,FILINF ;10 READ 5 WORDS OF FILE INFO
WRTINF ;11 WRITE 5 WORDS OF FILE INFO
DIAGL ;12 DIAGNOSTIC LOAD
DIAGW ;13 DIAGNOSTIC WRITE
GETRTR ;14 GET FILE RETRIEVAL DATA
INFCOM ;15 COMPARE A WORD IN DQINFO
ADDBLK ;16 FIX RETRIEVAL TO INCLUDE AN EXISTING BLOCK
FILEUP ;17 UPDATE ALL POINTERS AND HEADER INFO
RDOFF ;20 READ FILE RECORD OFFSET
WRTOFF ;21 SET FILE RECORD OFFSET
GODLEN←←.-GODDIS
; MTAPE CHN,[ ≠-1 ∧ ≠SIXBIT/GODMOD/ ]
; OR
; MTAPE CHN,[ SIXBIT/GODMOD/
; 0 ];POINTER COMES BACK HERE
GETPNT: MOVE TAC,USETP(DDB) ;GET USET POINTER
SUB TAC,DOFFST(DDB) ;DO OFFSET
XCTR XW,[MOVEM TAC,(UUO)] ;AND GIVE IT TO USER
POPJ P,
;CHECK DISK ABSOLUTE WRITE PRIVILEGE
DGODZ: MOVSI AC1,DAWPRV
TDNN AC1,JBTPRV(J) ;SKIP IF DISK ABSOLUTE WRITE PRIV
JRST UUOERR ;LOSER
POPJ P,
; GDWRIT, GDREAD
;CALL:
; MTAPE CHN,[ SIXBIT/GODMOD/
; 1=READ 2=WRITE
; IOWD WC,MA
; XWD S <RECORD #>,<DISK BLOCK ADDRESS> ]
; IO ERROR RETURN
; SUCCESS RETURN
;IF THE SIGN BIT (S) IS ON IN THE 4TH WORD THEN THIS TRANSFER WILL BE
;TO ONE OF THE EXTRA TRACKS AT THE END OF PACK 0. THE BLOCK ADDRESS
;SHOULD BE RELATIVE TO THE END OF THE PACK.
GDWRIT: XCTR XR,[HRRZ TAC,2(UUO)] ;MUST NOT WRITE SAT DIRECTLY
XCTR XR,[SKIPL 2(UUO)] ;DON'T BE FAKED OUT BY XTRA CYL WRITE
JUMPE TAC,UADRER ;(DON'T BE FOOLED BT A RECORD # - REG)
PUSHJ P,DGODZ ;IS HE LEGAL?
SKIPA TAC,[DWRITE!IOPCHN] ;MAKE IT A WRITE
GDREAD: MOVEI TAC,IOPCHN ;READ
MOVSM TAC,TFRCTL(DDB) ;WHICH DIRECTION
XCTR XR,[HLRZ TAC,1(UUO)] ;MAKE SURE ITS NOT TIC
JUMPE TAC,UADRER ;LOSE?
PUSHJ P,MTPACK ;CHECK AND RELOCATE IOWD!
XCTR XR,[SKIPGE TAC,2(UUO)] ;PICK UP DISK ADDRESS
JRST GDRD1 ;XTRA CYL TRANSFER
HRRZ TAC,TAC
CAILE TAC,LSTADR ;OFF END?
POPJ P, ;LET THE USER FIGURE OUT WHAT'S WRONG. (REG)
GDRD2: LSH TAC,6 ;POSITION FOR TRACK ADDRESS
XCTR XLB,[LDB TAC1,[POINT 6,2(UUO),17]] ;GET RECORD #
CAILE TAC1,RCPBLK ;LEGAL RECORD?
JRST UADRER
IOR TAC,TAC1 ;MERGE ADDRESS
XCTR XR,[SKIPGE 2(UUO)]
TLO TAC,200000 ;MARK AS XTRA CYL PACK 0 OP
MOVEM TAC,TFRSEC(DDB) ;STUFF INTO DDB
XCTR XR,[HLRO TAC,1(UUO)] ;GET WC AGAIN
IMULI TAC1,RECSIZ
SKIPE TAC1
SUBI TAC1,RECSIZ-SECSIZ
SUB TAC1,TAC ;AND "ADD" WC
CAILE TAC1,BLKWDS ;RUN OFF END OF BLOCK?
JRST UADRER
PUSHJ P,GOSET ;MAKE US UNSTOPPABLE
SETOM DDLOC(DDB) ;DISABLE DSKQCK
MOVEI DAT,TSTART ;JUST DO OP
PUSHJ P,QEWAIT ;DO IT
SETZM DDLOC(DDB)
DEPOPJ: TRNE IOS,IODERR!IODTER ;ANY ERRORS?
JRST DPOPJ ;YES, NO SKIP
JRST DPOPJ1 ;NO, SKIP RETURN
MTPACK: XCTR XR,[HRRZ TAC1,1(UUO)] ;PICK UP ADDRESS
ADDI TAC1,1 ;MAKE IT HONEST
PUSHJ P,RELOCA ;ADDRESS CHECK AND RELOCATE
JRST UADRER
HRRM TAC1,TFRIOW(DDB) ;SAVE IN DDB
MOVE TAC,TFRCTL(DDB) ;GET MAGIC BIT
TLNN TAC,DWRITE ;IS IT WRITE?
JUMPL TAC1,UADRER ;NO, MUST HAVE WRITE (IN CORE) PERMISSION
XCTR XR,[HRRZ TAC1,1(UUO)]
XCTR XR,[HLRO TAC,1(UUO)]
SUB TAC1,TAC ;COMPUTE LAST ADDRESS OF TRANSFER
PUSHJ P,RELOCB ;ADDRESS CHECK, RELOCATE AND TEST SAME SEGMENT
JRST UADRER
XCTR XR,[HLLZ TAC1,1(UUO)]
HLLM TAC1,TFRIOW(DDB) ;SAVE IN DDB
POPJ P, ;OK
GDRD1: HRRZ TAC,TAC
CAIL TAC,NXTRA0*TRKCYL*BKPTRK
JRST UADRER
JRST GDRD2
; SETSAT, CLRSAT
;CALL:
; MTAPE CHN,[ SIXBIT/GODMOD/
; 3=SET BIT 4=CLEAR BIT
; DISK ADDRESS]
;
; CLEAR OR SET SAT BIT CORRESPONDING TO DISK ADDRESS
SETSAT: SKIPA AC2,[MRKBLK]
CLRSAT: MOVEI AC2,RTNBLK
PUSHJ P,DGODZ ;MUST BE GOD TO TWIDDLE BITS
XCTR XR,[SKIPLE TAC,1(UUO)] ;GET BLOCK ADDRESS
CAILE TAC,LSTBIT ;IN SAT TABLE?
JRST UADRER ;NO
JRST (AC2) ;SET OR CLEAR A BIT, AND POPJ
; SATWRT, SATRD, SATFRC
;CALL:
; MTAPE CHN,[ SIXBIT/GODMOD/
; 5=READ 6=WRITE
; IOWD WC,MA
; RELATIVE ADDRESS IN SAT TABLE]
;
; ADDRESS IS RELATIVE TO SATTAB, NOT SATBIT!!!!!
; READ OR WRITE PORTIONS OF SAT TABLE IN CORE!
SATWRT: PUSHJ P,DGODZ ;CHECK FOR GOD
PUSHJ P,SATSUP ;SAT SET UP
JFCL ;DON'T CARE, JUST READING
MOVSS TAC ;SWAP POINTERS TO BLT INTO SYSTEM
ADDI TAC1,-1(TAC) ;GET LAST LOC
BLT TAC,(TAC1) ;AND DO BLT
POPJ P,
SATRD: PUSHJ P,SATSUP ;SAT SET UP
JRST UADRER ;WRITE PROT, LOSE
ADDI TAC1,-1(TAC) ;GET LAST LOC
BLT TAC,(TAC1) ;GIVE INFO TO LOSER!
POPJ P,
SATSUP: XCTR XR,[HRRZ TAC1,1(UUO)] ;PICKUP USER ADDRESS
ADDI TAC1,1 ;MAKE IT HONEST
PUSHJ P,RELOCA ;ADDRESS CHECK AND RELOCATE
JRST UADRER
JUMPL TAC1,.+2 ;SKIP AOS IF WRITE PROT
AOS (P) ;SKIP RETURN
MOVE TAC,TAC1 ;SAVE IN TAC
XCTR XR,[HLRE AC2,1(UUO)] ;GET WC
MOVNS AC2 ;MAKE IT POS!
JUMPLE AC2,UADRER ;MUST NOW BE POS!
XCTR XR,[HRRZ TAC1,1(UUO)] ;GET MA AGAIN
ADD TAC1,AC2 ;COMPUTE LAST ADDRESS
PUSHJ P,RELOCB ;ADDRESS CHECK AND RELOCATE
JRST UADRER
XCTR XR,[SKIPGE AC1,2(UUO)] ;GET RELATIVE SAT ADDRESS
JRST UADRER
MOVE TAC1,AC2
ADD AC2,AC1 ;GET RELATIVE END OF SAT
CAILE AC2,SATEND-SATTAB ;INSIDE SAT?
JRST UADRER ;NO
HRLI TAC,SATTAB(AC1) ;PUT CORE ADDRESS OF FIRST WORD IN TAC
POPJ P, ;RETURN TO DO BLT
;CALL:
; MTAPE CHN,[ SIXBIT/GODMOD/
; 7 ]
;
;FORCE SAT TABLE TO BE WRITTEN OUT!
SATFRC: SETOM SATFLG ;LET ANYBODY FORCE SAT OUT
MOVEI DAT,SATOUT
JRST NEWAIT ;WAIT FOR IT
; FILINF, WRTINF
;CALL:
; MTAPE CHN,[ SIXBIT/GODMOD
; 10
; ADDRESS TO PUT INFO (5 WORDS) ]
; ERROR RETURN, NO LOOKUP DONE
; SUCCESS RETURN
FILINF: TLNN IOS,READB ;LOOKUP DONE?
POPJ P, ;NO
XCTR XR,[MOVE TAC1,1(UUO)]
ADDI TAC1,DQLEN-1 ;CHECK END OF TRANSFER FIRST
PUSHJ P,RELOCA
JRST UADRER
JUMPL TAC1,UADRER
XCTR XR,[MOVE TAC1,1(UUO)]
PUSHJ P,RELOCB
JRST UADRER
JUMPL TAC1,UADRER
HRLI TAC1,DQINFO(DDB) ;GET INFO FROM HERE
HRRZ TAC,TAC1
BLT TAC1,DQLEN-1(TAC)
JRST CPOPJ1
;CALL:
; MTAPE CHN,[ SIXBIT/GODMOD/
; 11
; ADDRESS OF 5 WORDS TO WRITE INTO RETRIEVAL ]
; ERROR RETURN
; SUCCESS RETURN
WRTINF: PUSHJ P,DGODZ
TDNE IOS,[XWD DEVSBB,IOACT]
PUSHJ P,WAIT1
SKIPE FILNAM(DDB) ;NO FILE TO RENAME?
TLNE IOS,DELETB ;OR GOING AWAY?
POPJ P, ;LOSSAGE RETURN
XCTR XR,[MOVE TAC1,1(UUO)]
ADDI TAC1,DQLEN-1
PUSHJ P,RELOCA
JRST UADRER
XCTR XR,[MOVE TAC1,1(UUO)]
PUSHJ P,RELOCB
JRST UADRER
HRLM TAC1,(P) ;SAVE USER ADDRESS FOR BLT'S
MOVE TAC1,JBTSTS(J)
TLNE TAC1,JACCT ;DON'T PRINT THIS FOR LOGIN/OUT
JRST LINOUT
PUSHJ P,DISDATE
PUSHJ P,DISERR
[ASCIZ/WRITE INFO, USER = /]
DISARG SIX,<PRJPRG(J)>
[ASCIZ/ PROGRAM = /]
DISARG SIX,<JOBNAM(J)>
[ASCIZ/ TTY/]
DISARG LOC,<JBTLIN(J)>
[ASCIZ/
FILE = /]
DISARG SIX,<FILNAM(DDB)>
[ASCIZ/./]
DISARG SIX,<FILEXT(DDB)>
[ASCIZ/[/]
DISARG SIX,<FILPPN(DDB)>
[ASCIZ/]
/]
-1
LINOUT: MOVEI AC3,DQLEN ;GET BLOCK OF FREE STORAGE
PUSHJ P,UFSGET ;GET IT
PUSH P,AC1
HLLZ TAC1,-1(P) ;GET SAVED USER ADDR
HRR TAC1,AC1 ;SYSTEM ADDR
BLT TAC1,DQLEN(AC1) ;SAVE WORDS IN FREE STORAGE
PUSHJ P,FILEUP ;FORCE OUT POINTERS IF NECESSARY
POP P,SRCTMP(DDB) ;SAVE ADDRESS
TRZ IOS,IODERR!IODTER ;NO ERRORS YET!
TLO IOS,RENAMB ;LOCK UP FILE WHILE WE'RE IN IT
PUSHJ P,GOSET ;LEST WE GET STOPPED
PUSH P,USETP(DDB) ;SAVE CURRENT USET
MOVEI DAT,WRTINS ;I SUBR
PUSHJ P,NEWAIT
POP P,USETP(DDB) ;RESTORE USET
MOVE AC1,SRCTMP(DDB)
PUSHJ P,FSGIVE ;RETURN BLOCK
TLZ IOS,RENAMB ;UNLOCK FILE
JRST DEPOPJ
;***** I-SUBR FOR SMEARING OUT 5 WORD CHANGE TO DQINFO *****
WRTINS: MOVE TAC,FILLOC(DDB) ;HERE IS WHERE WE START
PUSHJ P,NEWFIL ;INITIALIZE FILE
WRTIN1: PUSHJ P,GGRETI ;GET RETRIEVAL IN
HRLZ TAC1,SRCTMP(DDB) ;GET FREE STORAGE ADDRESS
HRRI TAC1,DQINFO(DDB) ;AND DDB ADDRESS
BLT TAC1,DQINFO+DQLEN-1(DDB);BLT IN 5 WORDS
PUSHJ P,SPREAD ;SPREAD RET. OVER GROUP
SKIPN DNXTGP(DDB) ;ANOTHER TO GO?
POPJ P,
MOVEI TAC,RCPGRP ;INC USET TO NEXT GROUP
ADDM TAC,USETP(DDB)
JRST WRTIN1 ;AND LOOP
; WRTOFF, RDOFF
;CALL:
; MTAPE CHN,[ SIXBIT/GODMOD/
; 21
; NEW FIRST RECORD ]
; ERROR RETURN
; SUCCESS RETURN
WRTOFF: TDNE IOS,[XWD DEVSBB,IOACT]
PUSHJ P,WAIT1
SKIPE FILNAM(DDB) ;NO FILE TO RENAME?
TLNE IOS,DELETB ;OR GOING AWAY?
POPJ P, ;LOSSAGE RETURN
TLNE IOS,WRITEB ;ALREADY WRITING?
JRST WOFFOK ;YES, OK
MOVSI DAT,100000 ;CHANGE; IS IT LEGAL?
MOVE AC2,FILPPN(DDB)
MOVE AC3,FILPRO(DDB)
JSP AC1,PROTEK
WOFFOK: XCTR XR,[MOVE TAC1,1(UUO)] ;GET USER OFFSET REQUEST
SOJL TAC1,CPOPJ ;NORMALIZE AND TEST FOR TO SMALL
PUSH P,TAC1
PUSHJ P,FILEUP ;MAKE SURE POINTERS ARE OK
;BEFORE DIDLING THEM
POP P,SRCTMP(DDB)
TRZ IOS,IODERR!IODTER ;NO ERRORS YET!
TLO IOS,RENAMB ;LOCK UP FILE WHILE WE'RE IN IT
PUSHJ P,GOSET ;LEST WE GET STOPPED
PUSH P,USETP(DDB) ;SAVE CURRENT USET
MOVEI DAT,WRTOFS ;I SUBR
PUSHJ P,NEWAIT
POP P,USETP(DDB) ;RESTORE USET
TLZ IOS,RENAMB ;UNLOCK FILE
JRST DEPOPJ
;***** I-SUBR FOR SMEARING OUT DOFFST CHANGE *****
WRTOFS: MOVE TAC,FILLOC(DDB) ;HERE IS WHERE WE START
PUSHJ P,NEWFIL ;INITIALIZE FILE
WRTOF1: PUSHJ P,GGRETI ;GET RETRIEVAL IN
MOVE TAC1,SRCTMP(DDB) ;GET NEW OFFSET
MOVEM TAC1,DOFFST(DDB) ;SET INTO RETRIEVAL
PUSHJ P,SPREAD ;SPREAD RET. OVER GROUP
SKIPN DNXTGP(DDB) ;ANOTHER TO GO?
POPJ P,
MOVEI TAC,RCPGRP ;INC USET TO NEXT GROUP
ADDM TAC,USETP(DDB)
JRST WRTOF1 ;AND LOOP
;CALL:
; MTAPE CHN,[ SIXBIT/GODMOD/
; 20
; RECORD OFFSET STORED HERE
; ACTUAL FILE LENGTH ]
; ERROR RETURN
; SUCCESS RETURN
RDOFF: MOVE TAC,DOFFST(DDB)
ADDI TAC,1
XCTR XW,[MOVEM TAC,1(UUO)] ;REPORT STARTING RECORD #
MOVE TAC,FILLNG(DDB)
XCTR XW,[MOVEM TAC,2(UUO)] ;REPORT ACTUAL FILE LENGTH
POPJ P,
; DIAGL, DIAGW
;CALL:
; MTAPE CHN,[ SIXBIT/GODMOD/
; 12
; ADDRESS TO PUT DIAGNOSTIC (MUST BE 200 WORDS)
; FLOPPY DISK ADDRESS ]
; IO ERROR RETURN
; SUCCESS RETURN
DIAGL: XCTR XR,[MOVE TAC1,1(UUO)] ;PICK UP ADDRESS OF 200 WORD BUFFER
PUSHJ P,RELOCA
JRST UADRER
JUMPL TAC1,UADRER ;MUST HAVE WRITE PERMISSION
HRRZM TAC1,TFRIOW(DDB)
XCTR XR,[HRRZ TAC1,1(UUO)]
ADDI TAC1,177
PUSHJ P,RELOCB
JRST UADRER
XCTR XR,[MOVE TAC,2(UUO)] ;PICK UP FLOPPY DISK ADDRESS
CAILE TAC,377 ;MUST BE ONE BYTE
JRST UADRER
DPB TAC,[POINT 8,TFRSEC(DDB),7] ;PUT IN PLACE FOR PICK UP BY CHANNEL
MOVSI TAC,IOPCHN ;KLUDGE TO INDICATE READ
LWMERG: MOVEM TAC,TFRCTL(DDB)
PUSHJ P,GOSET ;LOCK HIM IN FOR THIS
MOVEI DAT,LWSTRT
PUSHJ P,QEWAIT ;START OP AND WAIT FOR IT
JRST DEPOPJ ;CHECK ERRORS AND UNLOCK
;CALL:
; MTAPE CHN,[ SIXBIT/GODMOD/
; 13
; ADDRESS TO GET DIAGNOSTIC FROM (MUST BE 200 WORDS)
; ADDRESS TO PUT ERROR CODE (4 WORDS) ]
; IO ERROR RETURN
; SUCCESS RETURN
DIAGW: PUSHJ P,DGODZ
XCTR XR,[MOVE TAC1,1(UUO)]
PUSHJ P,RELOCA
JRST UADRER
HRRZM TAC1,TFRSEC(DDB)
XCTR XR,[MOVE TAC1,1(UUO)]
ADDI TAC,177
PUSHJ P,RELOCB
JRST UADRER
XCTR XR,[MOVE TAC1,2(UUO)]
PUSHJ P,RELOCA
JRST UADRER
JUMPL TAC1,UADRER ;LOSE IF WRITE PROTECTED
HRRZM TAC1,TFRIOW(DDB)
XCTR XR,[MOVE TAC1,2(UUO)]
ADDI TAC,3
PUSHJ P,RELOCB
JRST UADRER
MOVSI TAC,DWRITE!IOPCHN
JRST LWMERG
;DIAGNOSTIC I-SUBR ************
LWSTRT: MOVEM DDB,DXB
MOVEM J,DXJ
MOVEM P,DXP
TRZ IOS,IODERR!IODTER
MOVE TAC,TFRSEC(DDB)
MOVEM TAC,DXS
MOVE TAC,TFRIOW(DDB)
MOVEM TAC,DXW
HLRZ TAC,TFRCTL(DDB)
MOVEM TAC,DXC
JRST WLDIAG ;DISPATCH TO DEVICE DEPENDENT SUBR
; GETRTR
;CALL:
; MTAPE CHN,['GODMOD'
; 14
; IOWD WC,MA] ;WC≤40
; <ERROR - NO LOOKUP OR ENTER>
;PLACE UP TO 40 WORDS OF FILE RETRIEVAL AT USER'S ADR.
;RETRIEVAL IS COPIED FROM THE DDB FOR THIS CHANNEL.
;USER MUST HAVE A FILE LOOKED UP SUCESSFULLY ALREADY.
;REG THIS PAGE
GETRTR: TLNN IOS,READB+WRITEB+ALTERB ;LOOKUP OR ENTER DONE?
POPJ P, ;NO
XCTR XR,[HRRZ TAC1,1(UUO)] ;GET HIS ADDRESS
XCTR XR,[HLRO TAC,1(UUO)] ;AND THE WC
CAMGE TAC,[-40]
JRST UADRER
SUB TAC1,TAC ;COMPUTE LAST ADDRESS OF TRANSFER
PUSHJ P,RELOCA ;
JRST UADRER
JUMPL TAC1,UADRER
XCTR XR,[HRRZ TAC1,1(UUO)] ;GET THE ADDRESS HE SAID
ADDI TAC1,1 ;MAKE IT HONEST
PUSHJ P,RELOCB
JRST UADRER
JUMPL TAC1,UADRER
HRLI TAC1,DDNAM(DDB) ;GET INFO FROM HERE
XCTR XR,[HLRO TAC,1(UUO)] ;GET -WC
MOVN TAC,TAC ;+WC
MOVE AC2,TAC ;REMEMBER THE WC
ADDI TAC,(TAC1) ;ADD BEGINNING ADDRESS
MOVEI AC1,(TAC1) ;SAVE USER'S ADDRESS
BLT TAC1,-1(TAC) ;MOVE DATA
MOVE TAC,JBTPRV(J) ;GET THIS GUY'S PRIVILEGES
CAILE AC2,DQINFO-DDNAM ;DID THIS USER READ SPECIAL STUFF?
TLNE TAC,INFPRV ;IS HE ALLOWED TO SEE ALL RETRIEVAL?
JRST CPOPJ1 ;PRIVILEGED OR DIDN'T ATTEMPT TO READ DQINFO
SETZM DQINFO-DDNAM(AC1) ;ZERO DQINFO
MOVSI TAC1,DQINFO-DDNAM(AC1) ;SOURCE
HRRI TAC1,DQINFO-DDNAM+1(AC1) ;DESTINATION OF BLT
CAILE AC2,DQINFO+DQLEN-DDNAM ;DOES WC EXCEED SPECIAL AREA?
MOVEI AC2,DQINFO+DQLEN-DDNAM ;YES. MAKE IT SMALLER.
ADDI AC2,-1(AC1) ;ADD TO MAKE LAST ADDRESS TO ZERO
CAIL AC2,(TAC1) ;IS THIS A NULL BLT?
BLT TAC1,(AC2) ;REAL BLT TO ZERO CORE.
JRST CPOPJ1 ;RETURN.
; INFCOM, ADDBLK, FILEUP
;CALL:
; MTAPE CHN,['GODMOD'
; 15
; 0-4 ;WHICH WORD TO COMPARE WITH
; DATA ] ;DATA TO BE COMPARED
; <NO LOOKUP OR ENTER OR COMPARE NOT EQUAL>
;THIS IS A UUO TO COMPARE A WORD FROM THE USER WITH ONE FROM
;THE SPECIAL 5 WORD RETRIEVAL BLOCK IN A FILE
INFCOM: TLNN IOS,READB!WRITEB!ALTERB
POPJ P,
XCTR XR,[MOVE TAC,1(UUO)] ;PICK UP INDEX INTO 5 WORD RETRIEVAL BLOCK
JUMPL TAC,UADRER ;CHECK IT
CAIL TAC,DQLEN
JRST UADRER
ADDI TAC,DQINFO(DDB) ;CALC ADDR OF WORD
MOVE TAC,(TAC) ;PICK IT UP
XCTR XR,[CAMN TAC,2(UUO)] ;EQUAL TO LOSERS WORD?
AOS (P) ;YES, SKIP
POPJ P,
;CALL:
; MTAPE CHN,['GODMOD'
; 16
; RECORD # (REAL, NOT OFFSET)]
; <NO LOOKUP OR ENTER OR NON-EX BLOCK>
;THIS UUO ALLOWS THE USER(LOSER) TO INCLUDE AN
;EXISTING BLOCK IN HIS WORD COUNT!
ADDBLK: TLNN IOS,ALTERB!WRITEB!READB ;FILE OPEN SOMEHOW?
POPJ P,
XCTR XR,[SKIPG TAC,1(UUO)] ;PICK UP LOSERS REC. NO.
POPJ P, ;AVOID CONFUSION
PUSH P,USETP(DDB) ;SAVE OLD USET POINTER IN CASE HE LOSES
ADD TAC,DOFFST(DDB) ;DO OFFSET
MOVEM TAC,USETP(DDB)
PUSHJ P,GOSET ;MAKE US UNSTOPPABLE IN CASE BAD POINTER
PUSHJ P,GETRET ;GET RETRIEVAL FOR RECORD
JRST ADDLOS ;NO SUCH GROUP
PUSHJ P,LR2BLK ;THE GROUP EXISTS, DOES THE BLOCK?
JUMPE TAC,ADDLOS ;0 MEANS NO SUCH BLOCK
SUB P,[1,,1] ;BLOCK EXISTS, LOSE OLD USETP
MOVE TAC,USETP(DDB) ;NOW INCLUDE THIS BLOCK IN WC
LSH TAC,RECWSH ;MAKE IT WORDS
CAMG TAC,FILLNG(DDB)
JRST DPOPJ1 ;ALREADY IN WC
MOVEM TAC,FILLNG(DDB) ;UPDATE FILE LENGTH
TLNE IOS,ALTERB!WRITEB ;WRITING?
TLO IOS,HDRDIF ;YES, MAKE SURE IT GETS WRITTEN OUT LATER
TDZ IOS,[IOEND,,IODEND] ;CAN'T BE EOF ANY MORE
JRST DPOPJ1
ADDLOS: POP P,USETP(DDB) ;NO SUCH RECORD, GET BACK OLD ONE
JRST DPOPJ ;AND GIVE ERROR RETURN
;CALL
; MTAPE CHN,['GODMOD'
; 17 ]
FILEUP: TLNE IOS,ALTERB!WRITEB ;FILE OPEN?
TLNN IOS,PNTDIF!HDRDIF ;YES, ANYTHING TO DO?
POPJ P, ;NO, NO-OP
MOVEI DAT,DCLOI
JRST NENTER ;ENTER REQUEST AND RETURN TO USER
;LOOKUP
DLOOK: TLZ IOS,IO!READB
TLNE IOS,WRITEB
JRST EXFIL ;THIS DDB IS ALREADY WRITING
SETZM FILNAM(DDB) ;DISABLE RENAME.
JSP AC1,ACCENT
SKIPN ACCNAM(DDB) ;WAS THE SPECIFIED NAME BLANK?
JRST ENOFIL ;YES. LOSE.
PUSHJ P,GOSET
JSP AC1,ACCESS ;CHECK WHO'S DIDDLING FILE
JRST DLK1 ;READ ENTRY - BORROW DATA
JRST DLK2 ;WRITE ENTRY
PUSHJ P,FILSRC ;SEARCH DIRECTORY FOR FILE
SKIPG SRCTMP(DDB)
JRST ENOFIL ;NOT FOUND, LOSE
MOVE TAC,SRCEXT(DDB)
MOVEM TAC,ACCEXT(DDB)
MOVE TAC,SRCPRO(DDB)
MOVEM TAC,ACCPRO(DDB)
JRST DLK3 ;GO CHECK PROTECTION.
DLK2: TLNN TAC1,NTRUFD ;WRITING; IS THERE AN OLD FILE?
JRST ENOFIL ;JUST NEW ONE, REPORT NON EX
JRST ACCES1 ;THERE IS AN OLD ONE, SEEK IT
DLK1: MOVE TAC1,FILEXT(TAC) ;READ ENTRY FOUND. - BORROW DATA
MOVEM TAC1,SRCEXT(DDB)
MOVEM TAC1,ACCEXT(DDB)
MOVE TAC1,FILPRO(TAC) ;STEAL DATA
MOVEM TAC1,SRCPRO(DDB)
MOVEM TAC1,ACCPRO(DDB)
SKIPN TAC1,FILLOC(TAC)
MOVE TAC1,SRCLOC(TAC)
MOVEM TAC1,SRCLOC(DDB)
MOVE TAC1,UFDPRO(TAC)
MOVEM TAC1,UFDPRO(DDB)
DLK3: MOVSI DAT,200000
JSP AC1,UPROTC ;CHECK READ ACCESS TO UFD
MOVSI DAT,200000 ;CHECK READ PROTECTION.
JSP AC1,PROTEC
TLO IOS,READB
PUSHJ P,ACCEST ;OK, ACCESS ESTABLISHED
SKIPLE TAC,SRCLOC(DDB) ;REASONABLE ADDRESS?
CAILE TAC,LSTBIT ;IF NOT,
JRST EGARB1 ;UFD HAS BAD POINTER IN IT.
MOVEI DAT,LOOKI
PUSHJ P,QEWAIT ;UPDATE TIMES, GET LENTGH
TLNE IOS,LOSBIG
JRST EGARB2 ;WRONG FILE FOUND AT LOC.
DRPT: MOVEI AC1,3(UUO) ;END ADDRESS
TRNE IOS,DMPBIT ;UNLESS DMPBIT SET
ADDI AC1,2 ;THEN 2 LONGER
HLRZ TAC,PROG
CAIL TAC,(AC1) ;ADDRESS IN LOWER?
JRST DRPT2 ;ENDS IN LOWER
TRNN UUO,400000 ;UPPER STARTING ADDRESS?
JRST ADRERR ;NO
LDB TAC1,PSEGN
JUMPE TAC1,ADRERR
MOVE TAC,JBTSTS(TAC1)
TLNE TAC,JWP ;WRITE PROTECTED?
JRST ADRERR ;YES, LOSE
HLRZ TAC,JBTADR(TAC1)
CAIGE TAC,-400000(AC1) ;END IN UPPER?
JRST ADRERR ;NO, LOSE
HRRZ TAC,JBTADR(TAC1)
SUBI TAC,400000
JRST DRPT1
DRPT2: HRRZ TAC,PROG
DRPT1: ADDI TAC,(UUO) ;REPORT DATA TO USER
PUSH TAC,FILEXT(DDB)
PUSH TAC,FILPRO(DDB)
MOVN TAC1,DDLNG(DDB)
TLNE IOS,ALTERB ;ARE WE GETTING INTO ALTER MODE?
MOVN TAC1,FILLNG(DDB) ;YES, USE HONEST FILE LENGTH!
MOVNM TAC1,FILLNG(DDB)
MOVE AC1,DOFFST(DDB)
LSH AC1,RECWSH ;MAKE IT WORDS
ADD TAC1,AC1 ;REPORT ADJUSTED SIZE TO USER
SKIPLE TAC1
SETZ TAC1, ;ACCOUNT FOR DOFFST BEING EOF
MOVSS TAC1
PUSH TAC,TAC1
MOVE TAC1,DREFTM(DDB) ;BEGIN RPH 3-8-73
MOVEM TAC1,REFTIM(DDB) ;UPDATE THIS CRUFT
TRNE IOS,DMPBIT
PUSH TAC,TAC1
MOVE TAC1,DDMPTM(DDB)
MOVEM TAC1,DMPTIM(DDB)
TRNE IOS,DMPBIT
PUSH TAC,TAC1 ;END RPH
DLOK: PUSHJ P,DGETL
MOVE TAC1,DOFFST(DDB)
ADDI TAC1,1 ;INIT USETP POINTER TO OFFSET
CAMLE TAC,TAC1 ;DOFFST INSIDE FILE?
MOVE TAC,TAC1 ;OK, USE DOFFST
MOVEM TAC,USETP(DDB)
DPOPJ1: AOS (P)
DPOPJ: TLZ IOS,GOBIT
MOVEM IOS,DEVIOS(DDB)
CONSZ PI,177B27 ;ARE WE AT UUO LEVEL?
POPJ P, ;NO, CAN'T DO ANYTHING HERE!
PUSH P,AC3
MOVE J,JOB(PID)
MOVE AC3,JBTLIN(J)
CAMN AC3,[-1] ;DETACHED?
JRST DPJRA3
PUSH P,AC2
PUSH P,AC1
MOVSI AC1,DLYBIT
MOVSI AC2,COMBIT
CONO PI,SCNOFF ;KEEP SCANNER OUT.
TDNN AC1,TTYTAB(AC3) ;SKIP IF COMMAND DELAYED
JRST DPJRSC ;NO DELAYED COMMAND
ANDCAM AC1,TTYTAB(AC3) ;TURN OFF DELAY BIT
TDNE AC2,TTYTAB(AC3) ;ANOTHER COMMAND ALREADY IN?
JRST DPJRSC ;YES.
AOS COMCNT ;COUNT ANOTHER TTY NEED SCANNING
IORM AC2,TTYTAB(AC3) ;TURN ON COMMAND BIT
IFN FTTTYBUG,<
PUSHJ P,COMBCK
PUSHJ P,CNTCOM ;MAKE SURE ALL IS WELL
>
CONO PI,SCNON
PUSHJ P,WSCHED
DPJRST: POP P,AC1
POP P,AC2
DPJRA3: POP P,AC3
POPJ P,
DPJRSC: CONO PI,SCNON
JRST DPJRST
GOSET: TLO IOS,GOBIT
DSIOS: MOVEM IOS,DEVIOS(DDB)
POPJ P,
;*** INTERRUPT SUBR ***
LOOKI: MOVE TAC,SRCLOC(DDB) ;GET RTVL INTO DDB
MOVEM TAC,FILLOC(DDB)
PUSHJ P,NEWFIL
PUSHJ P,GETBLK
PUSHJ P,AUDCHK
TRNE IOS,DMPBIT ;MAKE THIS TRNE IF REFTIM REQUIRED
POPJ P,
MOVE TAC1,THSDAT ;USE DATE ONLY FOR REFERENCE TIME
CAMG TAC1,DREFTM(DDB) ;DON'T UPDATE MORE THAN ONCE A DAY
POPJ P,
SKIPN TTYLOK ;IN MAINTMODE, DON'T WRITE
SKIPE MAINTM
POPJ P,
MOVEM TAC1,REFTIM(DDB)
MOVEM TAC1,DREFTM(DDB)
MOVEM TAC1,DREFTM+SYSRTV
MOVE TAC,[XWD -40,SYSBUF]
MOVEM TAC,TFRIOW(DDB) ;DON'T REWRITE WHOLE BLK.
JRST RERITE
;ENTER
DENTER: JSP AC1,ACCENT
SKIPN ACCNAM(DDB)
JRST ENOFIL ;BLANK NAME LOSES
TLNE IOS,READB ;HAS LOOKUP BEEN DONE?
JRST DALTER ;YES, IS ALTER
SETZM FILNAM(DDB) ;DISABLE RENAME.
SETOM SRCTMP(DDB) ;INITIALIZE FLAG
JSP AC1,ACCESS ;SEE WHO'S LOOKING
JRST DENT0 ;READ - SAVE DATA
JRST EFWRIT ;WRITE - LOSE
TLO IOS,IO!WRITEB!GOBIT
PUSHJ P,ACCEST ;ACCESS OURS
SKIPG SRCTMP(DDB) ;WAS SOMEONE READING?
PUSHJ P,FILSRC ;NO, GET DATA
TLZ IOS,WRITEB!NTRUFD ;TURN OFF IN CASE PROTECTION CHECK
MOVEM IOS,DEVIOS(DDB) ; FAILS
MOVSI DAT,100000
JSP AC1,UPROTC
SKIPG SRCTMP(DDB) ;THIS NAME IN USE?
JRST DENT1 ;NO FILE FOUND
MOVSI DAT,100000 ;FOUND, CHECK PROTECTION.
JSP AC1,PROTEC ;WRITE ACCESS REQUIRED.
LDB AC1,[POINT 9,FILPRO(DDB),8]
JUMPN AC1,DENT1A ;JUMP IF USER SPECIFIED PROTECTION
LDB AC1,[POINT 9,SRCPRO(DDB),8] ;USE OLD FILE'S PROT
DPB AC1,[POINT 9,FILPRO(DDB),8] ;...AS NEW FILE'S PROTECTION
DENT1A: TLOA IOS,NTRUFD!WRITEB ;INDICATE CHANGE UFD AT CLOSE.
DENT1: TLOA IOS,WRITEB ;NEW NAME. PUT IN UFD NOW.
SKIPA TAC1,SRCEXT(DDB) ;USE OLD CREATION DATE AS DEFAULT
MOVE TAC1,THSDAT ;USE CURRENT DATE AS DEFAULT
LDB TAC,[POINT 15,ACCEXT(DDB),35] ;BELIEVE ANY CREATE DATE
JUMPN TAC,DENT4 ;USER TELLS US.
MOVE TAC,TAC1
DPB TAC,[POINT 15,ACCEXT(DDB),35]
DENT4: DPB TAC,[POINT 15,FILEXT(DDB),35]
DENT2: MOVEM IOS,DEVIOS(DDB)
TRNE IOS,DMPBIT
JRST DENT3 ;DON'T INIT TIME IF DUMPER
SETZM DDMPTM(DDB) ;NEW FILE NEVER DUMPED.
SETZM DMPTIM(DDB)
MOVE TAC1,THSDAT ;REFERENCE DATE
MOVEM TAC1,REFTIM(DDB)
MOVEM TAC1,DREFTM(DDB)
PUSHJ P,DSKTM1 ;GET DATE AND TIME LAST WRITTEN
DPB TAC,[POINT 3,ACCEXT(DDB),20] ;STORE EXTRA BITS
DPB TAC,[POINT 3,FILEXT(DDB),20]
MOVSI TAC,777000 ;USE SPECIFIED PROTECTION
AND TAC,FILPRO(DDB) ;GET PROTECTION THUS FAR
JUMPN TAC,DENT2A ;JUMP IF THERE'S NON-ZERO ALREADY
TLNE IOS,NTRUFD ;SKIP IF NEW FILE.
JRST DENT2A ;REPLACING OLD FILE - KEEP 0 PROT
;HERE WE USE UFD'S DEFAULT PROTECTION WORD FOR PROTECTION OF THIS NEW FILE
MOVEI TAC,777000
AND TAC,UFDPR1(DDB) ;DEFAULT PROTECTION VALUE FROM UFD
MOVSI TAC,(TAC)
DENT2A: OR TAC1,TAC
DPB IOS,[POINT 4,TAC1,12] ;DATA MODE
MOVEM TAC1,FILPRO(DDB)
MOVEM TAC1,ACCPRO(DDB)
MOVSI IOS,HDRDIF
IORB IOS,DEVIOS(DDB) ;MAKE SURE DATE GOES OUT EVENTUALLY
DENT3: TLNE IOS,ALTERB
JRST ENTREN ;PUT OUT DATE IF ALTER MODE
MOVE TAC,DSKUSE ;SEE IF ANY SPACE LEFT
CAILE TAC,LSTBIT-=200 ;SOFT STOP WITH 200K DISK LEFT.
JRST ENTFUL ;GIVE NO ROOM MESSAGE. ERROR RETURN
PUSHJ P,ASNBLK ;GET SPACE FOR NEW FILE
MOVEM TAC,FILLOC(DDB)
MOVE TAC,DDLOC(DDB) ;UFD LOCN FOR DIRINS
MOVEM TAC,SRCLOC(DDB)
TLNN IOS,NTRUFD
PUSHJ P,DIRINS ;NEW FILE TO UFD NOW.
SETZM FILLNG(DDB)
SETZM DQINFO(DDB) ;INITIALIZE MAGIC FILE INFO
SETZM DQINFO+1(DDB)
HLRZ TAC,FILEXT(DDB)
CAIE TAC,UFDEXT
JRST NENUFD ;NOT ENTERING A UFD
MOVE TAC,FILPPN(DDB)
CAME TAC,SYSPPN
JRST NENUFD
SETZM DQINFO+2(DDB) ;CLEAR WORDS WHEN ENTERING A UFD
SETZM DQINFO+3(DDB)
JRST WENUFD
NENUFD: MOVE TAC,JOBNAM(J) ;UPDATE PPN AND JOB OF WRITER
MOVEM TAC,DQINFO+2(DDB)
MOVE TAC,PRJPRG(J)
MOVEM TAC,DQINFO+3(DDB)
WENUFD: SETZM DOFFST(DDB) ;INIT OFFSET
PUSHJ P,AUDINF
MOVE TAC,FILLOC(DDB)
PUSHJ P,NEWFI1
PUSHJ P,ASNGR1 ;SET UP RTVL
MOVEI DAT,SPREAD
TLNN IOS,NTRUFD ;IF NEW FILE,
PUSHJ P,QEWAIT ;PUT RTVL OUT.
JRST DRPT ;REPORT DATA TO USER.
DENT0: MOVE TAC1,FILPRO(TAC) ;READER FOUND, SAVE PROTECTION.
MOVEM TAC1,SRCPRO(DDB)
MOVE TAC1,FILEXT(TAC)
HRRM TAC1,SRCEXT(DDB)
MOVE TAC1,UFDPRO(TAC)
MOVEM TAC1,UFDPRO(DDB)
MOVEI TAC1,1 ;SET FLAG: ITEM FOUND
MOVEM TAC1,SRCTMP(DDB)
JRST ACCES1 ;KEEP LOOKING FOR WRITERS
ENTREN: PUSHJ P,ALTREN ;WRITE DATE INTO UFD
JFCL ;CAN'T GET ERROR RETURN???
JRST DRPT ;RETURN LOOKUP INFO
DALTER: TLOE IOS,ALTERB
JRST EFWRIT ;ALREADY ALTERING
MOVE TAC,FILNAM(DDB) ;SAME FILE?
CAME TAC,ACCNAM(DDB)
JRST EANAME
HLLZ TAC,FILEXT(DDB)
HLLZ TAC1,ACCEXT(DDB)
CAME TAC,TAC1
JRST EANAME
MOVE AC2,FILPPN(DDB)
CAME AC2,ACCPPN(DDB)
JRST EANAME
MOVSI DAT,100000
JSP AC1,UPROTC ;SEE IF UFD ALLOWS THIS ACCESS
MOVSI DAT,100000 ;NEEDS WRITE ACCESS
MOVE AC3,FILPRO(DDB)
JSP AC1,PROTEK
JSP AC1,ACCESS ;IS ANYONE USING FILE?
JRST EFWRIT ;IF SO, LOSE
JRST EFWRIT
JRST DENT2 ;STORE IOS & SKIP RETURN.
;RENAME
DRENAM: TDNE IOS,[XWD DEVSBB,IOACT]
PUSHJ P,WAIT1 ;FINISH CURRENT BUSINESS
SKIPN FILNAM(DDB)
JRST EXFIL ;LOSE IF NO ACCESSED FILE.
TLNE IOS,NTRUFD!DELETB ;IF FILE TO BE DELETED,
;OR OVERWRITING AND NO CLOSE
JRST ENOFIL ;CAN'T RENAME.
TLNN IOS,READB ;IF READING, TEST UNIQUE ACCESS.
JRST DRE0 ;OTHERWISE, ALREADY UNIQUE.
XCTR XR,[MOVE AC2,(UUO)] ;NEW FILE NAME
JSP AC1,ACCESS ;IS ANYONE ELSE RENAMING FILE?
JUMPN AC2,EFWRIT ;LOSE UNLESS DELETING
JFCL ;CAN'T AFFECT FOREIGN WRITER
DRE0: PUSHJ P,FILEUP ;FORCE RETRIEVAL SO WE DON'T MUNG IT
PUSHJ P,GOSET
TRNE IOS,DMPBIT
JRST DRE0A ;DON'T INIT TIME IF DUMPER
MOVE TAC1,THSDAT ;GET REFERENCE DATE
MOVEM TAC1,REFTIM(DDB) ;UPDATE REFTIM FOR RANDOM LOSER
DRE0A: JSP AC1,ACCENT ;JUST US. PICK UP UUO ARGS.
SKIPN TAC,ACCNAM(DDB)
JRST DRNMC ;DELETING, CHECK WRITE PROT
MOVE TAC,ACCPRO(DDB)
XOR TAC,FILPRO(DDB) ;PROTECTION CHANGE?
TLNN TAC,777000
JRST DRE1 ;NO CHANGE
MOVE AC2,FILPPN(DDB)
CAME AC2,SYSPPN
JRST DRE0B ;NOT ACCESS TO A UFD
MOVE AC2,FILNAM(DDB) ;UFD ACCESS. TO MFD?
CAMN AC2,SYSPPN
JRST EPROT ;CHANGE PROT OF MFD NOT ALLOWED
MOVE AC1,JBTPRV(J)
TLNN AC1,PROPRV ;PRIVILEGED?
CAMN AC2,PRJPRG(J) ;NO. BUT ACCESS TO OWN UFD OK
JRST DRE1
JRST EPROT
DRE0B: MOVSI DAT,400000
JSP AC1,UPROTK ;LEGAL TO CHANGE IN THIS UFD?
MOVSI DAT,400000
MOVE AC3,FILPRO(DDB)
JSP AC1,PROTEK ;LEGAL TO CHANGE THIS FILE?
DRE1: MOVE TAC,FILNAM(DDB)
CAME TAC,ACCNAM(DDB)
JRST DRNMC ;NAME CHANGE.
HLLZ TAC1,FILEXT(DDB)
XOR TAC1,ACCEXT(DDB)
TLNE TAC1,777777 ;EXT CHANGE?
JRST DRNMC
MOVE TAC1,FILPPN(DDB)
CAME TAC1,ACCPPN(DDB) ;NEW PROJ.-PROG?
JRST DRNMC ;YES, NEW PPN
ALTREN: PUSHJ P,FILSRC ;LITTLE OR NO CHANGE. GET RTVL IN.
JRST DRE2
DRNMC: MOVSI DAT,100000 ;NAME CHANGE REQUIRES WRITE ACCESS
MOVE AC2,FILPPN(DDB)
JSP AC1,UPROTK ;UFD ALLOWS WRITE ACCESS?
MOVSI DAT,100000
MOVE AC3,FILPRO(DDB)
JSP AC1,PROTEK ;FILE ALLOWS WRITE ACCESS?
JUMPE TAC,DRDEL ;0 = DELETE.
JSP AC1,ACCESS ;NEW NAME; SEE IF IN USE.
JRST EDNAME
JRST EDNAME ;YES, LOSE.
TLO IOS,RENAMB ;ESTABLISH UNIQUE ACCESS NOW!
MOVEM IOS,DEVIOS(DDB)
MOVE AC3,UFDPRO(DDB) ;THIS GETS CLOBBERED BY FILSRC
MOVEM AC3,UFDPR1(DDB)
PUSHJ P,FILSRC ;SEE IF IN DIRECTORY.
TLZ IOS,RENAMB ;IN CASE OF ACCIDENT, RELEASE ACCESS
MOVE AC3,UFDPR1(DDB) ;GET BACK PROTECTION OF SOURCE UFD
EXCH AC3,UFDPRO(DDB) ;DESTINATION UFD PROTECTION IN AC3
SKIPLE TAC,SRCTMP(DDB) ;DOES FILE NAME EXIST?
JRST EDNAME ;FILE NAME IS IN USE. (STORES IOS)
TRNN IOS,DMPBIT
SETZM DMPTIM(DDB) ;CLEAR DUMP DATE, UNLESS DUMPER
DRE2: TLO IOS,RENAMB ;KEEP HACKERS OUT WHILE...
MOVEM IOS,DEVIOS(DDB) ;CHANGING THINGS.
MOVE TAC,DDLOC(DDB) ;POINTS TO DESTINATION UFD ALWAYS
MOVEM TAC,SRCLOC(DDB) ;TELL DIRSRC WHERE TO LOOK.
MOVE TAC,ACCPPN(DDB) ;COMPARE PPN
CAMN TAC,FILPPN(DDB)
JRST DREC1 ;SAME PPN, CHANGE 1 UFD
MOVSI DAT,100000 ;REQUIRES WRITE ACCESS TO OTHER UFD
MOVE AC2,ACCPPN(DDB) ;GET PPN OF DESTINATION. AC3 SETUP
JSP AC1,PROT0 ;SEE IF ACCESS ALLOWED.
MOVE TAC,FILEXT(DDB) ;COPY CREATION DATE FROM RETRIEVAL
DPB TAC,[POINT 15,ACCEXT(DDB),35] ;INTO USERS VARIABLES
;(WILL BE COPIED BACK LATER)
TRNE TAC,700000 ;CHECK THIS PART OF DATE
JRST DRE3 ;USER IS SPECIFYING DATE & TIME
MOVE TAC,ACCPRO(DDB)
TDNE TAC,[777,,777777] ;ANY DATE AND TIME?
JRST DRE3 ;YES, USE IT
MOVE TAC,FILPRO(DDB) ;NO, USE THOSE FROM RETRIEVAL
TLZ TAC,777000 ;CLEAR PROT.
IORM TAC,ACCPRO(DDB)
LDB TAC,[POINT 3,FILEXT(DDB),20]
DPB TAC,[POINT 3,ACCEXT(DDB),20]
DRE3: PUSHJ P,DIRINS ;CHANGE 2 UFD'S. INSERT NEW
MOVEI TEM,FILNAM(DDB)
PUSHJ P,SRCH1 ;FIND OLD UFD
SKIPA DAT,[DR2INT] ;AND REMOVE OUR ENTRY
DREC1: MOVEI DAT,DRINT ;CHANGE 1 UFD ONLY
MOVE AC1,FILLNG(DDB)
CAILE AC1,=50*2000
JRST DRE8
PUSHJ P,QEWAIT
JRST DRE7
DRE8: PUSHJ P,NEWAIT
DRE7: TLZA IOS,RENAMB ;SEE US SAVE A WORD OF CODE.
DRDEL: PUSHJ P,DCLSO9 ;ARRANGE TO DELETE FILE.
JRST DPOPJ1
;***INTERRUPT LEVEL SUBRS***
DRAUFX: AOS DRAUFO
POPJ P,
DRAUFD: SKIPN TAC,FILNAM(DDB) ;FIND ENTRY FOR OLD NAME
JRST DRAUFX ;NULL NAME? RETURN NO FILE FOUND.
MOVEM TAC,SRCNAM(DDB) ;(UFD WAS FOUND BY FILSRC)
MOVE TAC,FILEXT(DDB)
HLLZM TAC,SRCEXT(DDB)
PUSHJ P,DIRSRC ;FIND UFD ENTRY
SKIPG SRCTMP(DDB)
JRST DRAUFX ;NO OLD FILE FOUND!
MOVE TAC,ACCNAM(DDB) ;CHANGE IT
MOVEM TAC,SYSDTA+UNAM(TAC1) ;(ALSO USED FOR DELETE)
MOVE TAC,ACCEXT(DDB)
HLLM TAC,SYSDTA+UEXT(TAC1)
MOVE TAC,SYSDTA+UEXT(TAC1) ;NOW COPY CREATION DATE BACK
DPB TAC,[POINT 15,ACCEXT(DDB),35] ;RPH/DATE75
LDB TEM,[POINT 3,ACCEXT(DDB),20] ;GET DATE
MOVE TAC,ACCPRO(DDB) ;AND TIME
TDNN TAC,[777,,777777] ;DID HE SPECIFY ANY?
JUMPE TEM,UOLDAT ;CHECK IT ALL
JRST UNEWDA ;USER SPECIFYING DATE AND TIME
UOLDAT: LDB TEM,[POINT 3,FILEXT(DDB),20] ;COPY 3 EXTRA BITS
DPB TEM,[POINT 3,ACCEXT(DDB),20]
MOVE TAC,FILPRO(DDB) ;NOW REST OF DATE AND TIME
DPB TAC,[POINT 23,ACCPRO(DDB),35]
MOVE TAC,ACCPRO(DDB)
UNEWDA: DPB TEM,[POINT 3,SYSDTA+UEXT(TAC1),20] ;STORE BITS IN UFD ENTRY
MOVEM TAC,SYSDTA+UPRO(TAC1) ;AND THE REST TOO
MOVE TAC,FILLOC(DDB) ;NEW FILE LOCATION.
EXCH TAC,SYSDTA+UPPN(TAC1) ;OLD ONE USED BY CLOSE OUTPUT.
MOVEM TAC,SRCLOC(DDB)
REWRIT: MOVEI TAC,IOPCHN!DWRITE
MOVSM TAC,TFRCTL(DDB)
PUSHJ P,TSTART ;WRITE IT BACK OUT.
POPJ P,
DRINT: PUSHJ P,DRAUFD
DRINT1: MOVE TAC,FILEXT(DDB)
PUSHJ P,ACCST1 ;UPDATE NAME.
HRRM TAC,FILEXT(DDB) ;RESTORE TIME
MOVE TAC,FILLOC(DDB) ;PREPARE TO SPREAD IT
PUSHJ P,NEWFIL
DRINL: PUSHJ P,GGRETI ;WRITE NEW NAME OVER FILE
TLNN IOS,ALTERB ;ARE WE ENTERING R-A MODE,
JRST DRINL2 ;UPDATE JOB AND PPN OF CULPRIT
HLRZ TAC,FILEXT(DDB) ;EXCEPT FOR UFDS
CAIE TAC,UFDEXT
JRST DRINL1
MOVE TAC,FILPPN(DDB)
CAMN TAC,SYSPPN
JRST DRINL2
DRINL1: MOVE TAC,JOBNAM(J)
MOVEM TAC,DQINFO+2(DDB)
MOVE TAC,PRJPRG(J)
MOVEM TAC,DQINFO+3(DDB)
DRINL2: PUSHJ P,AUDINF ;COPY NEW INFO IN RETRIEVAL AREA
PUSHJ P,SPREAD
SKIPN DNXTGP(DDB)
POPJ P, ;END FILE, RETURN
MOVEI TAC,RCPGRP
ADDM TAC,USETP(DDB)
JRST DRINL
; WE GET HERE TO DELETE ENTRY IN OLD UFD
; PPN CHANGE ONLY
; ENTRY HAS ALREADY (SUPPOSEDLY) BEEN INSERTED IN NEW UFD
DR2INT: PUSHJ P,DIRSRC ;FIND ENTRY IN OLD UFD
SKIPG SRCTMP(DDB) ;IS IT REALLY THERE?
JRST DRAUFX ;NO, LOSE LOSE
SETZM SYSDTA+UNAM(TAC1) ;DELETE ENTRY IN UFD
SETZM SYSDTA+UEXT(TAC1)
PUSHJ P,REWRIT
JRST DRINT1 ;SPREAD RETRIEVAL
;FILE ACCESS CONTROL.
ACCENT: MOVE J,JOB(PID)
XCTR XR,[MOVE TAC,UNAM(UUO)] ;NAME
MOVEM TAC,ACCNAM(DDB)
XCTR XR,[MOVE TAC,UEXT(UUO)] ;EXT
MOVEM TAC,ACCEXT(DDB)
XCTR XR,[MOVE TAC,UPRO(UUO)] ;PROT
MOVEM TAC,ACCPRO(DDB)
XCTR XR,[SKIPN TAC,UPPN(UUO)] ;PPN
IFN FTDSKPPN,< SKIPE TAC,DSKPPN(J) ;PICK UP DISK ALIAS PPN IF ANY
CAIA >;FTDSKPPN
MOVE TAC,PRJPRG(J) ;USE USER'S PPN IF BLANK
TLNE DDB,SYSDEV ;SYS?
MOVE TAC,CUSPPN ;YES, USE CUSP PPN
MOVEM TAC,ACCPPN(DDB)
TRNN IOS,DMPBIT
JRST (AC1)
XCTR XR,[MOVE TAC,4(UUO)]
MOVEM TAC,REFTIM(DDB)
XCTR XR,[MOVE TAC,5(UUO)]
MOVEM TAC,DMPTIM(DDB)
JRST (AC1)
ACCESS: MOVEI TAC,DSKDDB ;FIRST DDB IS DSK DUMMY
HLLZ DAT,ACCEXT(DDB) ;IN CASE RH NOT 0.
ACCES1: HLRZ TAC,DEVSER(TAC) ;GET NEXT DDB
HLRZ TAC1,DEVNAM(TAC) ;GET DEVICE NAME
CAIE TAC1,'DSK' ;IS IT "DSK"?
JRST 2(AC1) ;NO, ALL DONE, RETURN
CAIN TAC,(DDB) ;DON'T LOOK AT OWN DDB
JRST ACCES1
MOVE TAC1,FILNAM(TAC) ;COMPARE NAME
CAME TAC1,ACCNAM(DDB)
JRST ACCES1
HLLZ TAC1,FILEXT(TAC)
CAME TAC1,DAT
JRST ACCES1
MOVE TAC1,FILPPN(TAC)
CAME TAC1,ACCPPN(DDB)
JRST ACCES1
MOVE TAC1,DEVIOS(TAC) ;FOUND ONE, SEE WHAT IT'S DOING
TLNE TAC1,DELETB
JRST ACCES1 ;IGNORE IF TO BE DELETED.
TLNE TAC1,ALTERB!RENAMB ;ALTERING?
JRST EFWRIT ;YES, LOSE
TLNE TAC1,READB ;READING?
XCT 0(AC1) ;YES
TLNE TAC1,WRITEB ;WRITING?
XCT 1(AC1) ;YES
JRST ACCES1 ;OK, LOOK FOR MORE.
ACCEST: MOVEM IOS,DEVIOS(DDB) ;ACCESS ESTABLISHED
ACCST1: MOVE TAC1,ACCNAM(DDB)
MOVEM TAC1,FILNAM(DDB)
MOVE TAC1,ACCEXT(DDB)
MOVEM TAC1,FILEXT(DDB)
MOVE TAC1,ACCPRO(DDB)
MOVEM TAC1,FILPRO(DDB)
MOVE TAC1,ACCPPN(DDB)
MOVEM TAC1,FILPPN(DDB)
POPJ P,
PROTEC: MOVE AC2,ACCPPN(DDB)
MOVE AC3,SRCPRO(DDB)
PROTEK: CAMN AC2,SYSPPN ;ACCESS TO A UFD?
JRST PROT3 ;YES.
PROT0: CAMN AC2,PRJPRG(J) ;OWNER ACCESS TO FILE?
JRST PROT1 ;YES. DO OWNER ACCESS TESTS
LSH AC3,3 ;NOT OWNER. SHIFT TO LOCAL-USER BITS
MOVE TAC1,JBTPRV(J) ;
TLNN TAC1,LUPPRV ;LOCAL USER?
LSH AC3,3 ;NO. SHIFT TO REMOTE-USER FIELD
LSH TAC1,2 ;SHIFT PRIVILEGE BITS TO CHECK PRIV ACCESS
TDNE TAC1,DAT ;IS ACCESS ALLOWED BY PRIVILEGE?
JRST (AC1) ;YES. PRIV. ACCESS TO FILE
JRST PROT2 ;CHECK NON-OWNER ACCESS
PROT1: TLZ DAT,600000 ;OWNER CAN READ OR RENAME
PROT2: TDNN DAT,AC3
JRST (AC1) ;OK
JRST EPROT ;LOSE
PROT3: TLNE DAT,500000 ;WRITE OR RENAME ACCESS TO UFD?
JRST PROT4 ;YES. THIS IS USUALLY ILLEGAL
MOVE AC2,ACCNAM(DDB) ;USE THE NAME INSTEAD OF PPN FOR LEGALITY
JRST PROT0 ;OTHERWISE, CONSIDER OTHER CLASS OF USERS
PROT4: JUMPGE DAT,PROT5 ;JUMP UNLESS 400000 ACCESS REQUESTED
MOVE TAC1,FILNAM(DDB) ;GET NAME OF THIS UFD
CAMN TAC1,PRJPRG(J) ;BELONGS TO US?
JRST (AC1) ;YES. PROTECTION CHANGE IS OK.
PROT5: MOVE TAC1,JBTPRV(J) ;WRITE OR RENAME ACCESS TO UFD
LSH TAC1,2
TDNN TAC1,DAT
JRST EPROT
JUMPL DAT,(AC1) ;LEGAL FOR PRIV' USER TO CHANGE PROT
SKIPN ACCNAM(DDB) ;WRITE IS LEGAL ONLY IF DELETING
JRST (AC1)
JRST EPROT
;HERE TO CHECK ACCESS TO A UFD
UPROTC: MOVE AC2,ACCPPN(DDB)
UPROTK: SKIPE AC3,UFDPRO(DDB)
JRST PROT0
JRST (AC1) ;AVOID WORK IF THIS IS A UFD ACCESS
;SEARCH MFD AND UFD FOR FILE.
;PUT DIRECTORY DATA IN SRCNAM,SRCEXT,SRCPRO,SRCLOC.
;FLAG IS LEFT IN SRCTMP.
; MFD, UFD FORMAT:
; NAME
; EXT, DATE CREATED
; PROT, MODE, TIME LAST WRITTEN
; LOCATION (LOGICAL BLOCK NO.)
FILSRC: PUSHJ P,SRCH
SKIPE DAT ;WANT MFD?
PUSHJ P,QEWAIT ;NO, READ DIRECTORY
TLNE IOS,LOSBIG
JRST EGARPJ
POPJ P,
UFDSRC: PUSHJ P,SRCH
JUMPN DAT,CPOPJ ;RETURN
JRST EACMFD ;ILLEG MFD OP.
SRCH: MOVEI TEM,ACCNAM(DDB)
SRCH1: MOVE DAT,MFDLOC
MOVEM DAT,SRCLOC(DDB)
MOVE TAC,UPPN(TEM)
MOVSI TAC1,UFDEXT
HLLZ AC3,UEXT(TEM)
CAME TAC,SYSPPN ;LOOKING FOR [1,1] FILE?
JRST SRCHM ;NO, GO SEARCH MFD FOR UFD
CAMN TAC1,AC3 ;IT IS [1,1], IS IT UFD?
CAME TAC,UNAM(TEM) ;IS UFD, IS IT MFD?
JRST SRCHU ;NO, SEARCH MFD FOR IT
MOVEM DAT,SRCTMP(DDB) ;YES, PLUG IN MFD STUFF
MOVE DAT,MFDEXT
MOVEM DAT,SRCEXT(DDB)
MOVE DAT,MFDPRO
MOVEM DAT,SRCPRO(DDB)
MOVEM DAT,UFDPRO(DDB) ;DEFINE ACCESS ALLOWED TO MFD
MOVEI DAT,0 ;MFD FLAG
POPJ P,
SRCHM: MOVEM TAC,SRCNAM(DDB)
MOVEM TAC1,SRCEXT(DDB)
CAMN TAC,CUSPPN ;IS THIS THE BLOODY CUSP?
SKIPN TAC1,CUSLOC ;YES, DO WE REMEMBER WHERE IT IS?
CAIA ;NO TO ONE OF THESE
JRST CUSSRC ;YES, GO SEARCH IT
IFN FTDSKPPN,<
SKIPN TAC1,DSKPPN(J)
MOVE TAC1,PRJPRG(J)
CAMN TAC,TAC1 ;HIS OWN UFD?
>;FTDSKPPN
IFE FTDSKPPN,< CAMN TAC,PRJPRG(J) >
SKIPN TAC1,JBTUFD(J) ;DO WE KNOW WHERE IT IS?
JRST SRCHM1 ;NO. LOOK IN MFD FOR ITS LOC.
CUSSRC: HRRZM TAC1,SRCLOC(DDB) ;TRY HERE.
JRST SRCHU ;GO GET UFD (BYPASS MFD SEARCH)
SRCHM1: MOVEI DAT,DIRSRC ;LOOK IN MFD FOR USER'S UFD
PUSHJ P,QEWAIT
TLNE IOS,LOSBIG
JRST EGARJ2
SKIPG SRCTMP(DDB) ;FOUND IT?
JRST ENOUFD ;NO, LOSE
MOVE TAC,SRCNAM(DDB) ;DID WE JUST LOOK AT GUY'S OWN UFD?
MOVE TAC1,SRCLOC(DDB)
IFN FTDSKPPN,< SKIPN DAT,DSKPPN(J)
MOVE DAT,PRJPRG(J)
CAMN TAC,DAT >;FTDSKPPN
IFE FTDSKPPN,< CAMN TAC,PRJPRG(J) >
MOVEM TAC1,JBTUFD(J)
CAMN TAC,CUSPPN
MOVEM TAC1,CUSLOC
SRCHU: HLLZ TAC1,UEXT(TEM)
MOVEM TAC1,SRCEXT(DDB)
MOVE TAC,UNAM(TEM) ;LOOK IN UFD FOR FILE
MOVEM TAC,SRCNAM(DDB)
MOVEI DAT,DIRSRC
POPJ P,
;INSERT A FILE NAME IN UFD.
;UFD RTVL MUST BE IN DDB.
DIRINS: MOVEI DAT,DIRI1 ;TRY TO PUT NEW NAME IN
PUSHJ P,QEWAIT ;WITHOUT EXTENDING UFD.
SKIPN SRCTMP(DDB) ;SUCCESSFUL?
POPJ P, ;YES, RETURN
PUSHJ P,MAKBLK ;NO ROOM, GET NEW BLOCK
MOVEI DAT,DIRI2
PUSHJ P,QEWAIT ;WRITE NEW NAME IN IT
POPJ P,
;*** INTERRUPT SUBRS ***
DIRI1: SETZM SRCNAM(DDB)
PUSHJ P,DIRSRC ;LOOK FOR A HOLE.
SKIPL SRCTMP(DDB) ;FOUND ONE?
JRST DIRIHF ;YES, GO USE IT.
SKIPN AC1,DDLNG+SYSRTV ;UFD WD CT
JRST DIRI1W ;ZERO LENGTH FILE MUST HAVE ROOM
IDIVI AC1,BKDSIZ ;ROOM IN THIS BLOCK?
CAIG AC2,BKDSIZ-4
JUMPN AC2,DIRI1W ;YES, GO FIX UNLESS INTEGRAL
;NUMBER OF BLOCKS
SETOM SRCTMP(DDB) ;FLAG MORE SPACE NEEDED
MOVEI DAT,RCPBLK
ADDM DAT,USETP(DDB)
POPJ P, ;BACK TO UUO LVL TO GET IT.
DIRIHF: MOVEI TAC1,SYSDTA-1(TAC1)
PUSH TAC1,ACCNAM(DDB)
PUSH TAC1,ACCEXT(DDB)
PUSH TAC1,ACCPRO(DDB)
PUSH TAC1,FILLOC(DDB)
SETZM SRCTMP(DDB) ;FLAG SUCCESSFUL.
JRST REWRIT ;SPIT IT BACK OUT
DIRI2: MOVEI TAC1,0
DIRI1W: PUSH P,TAC1
MOVEI DAT,4
ADDM DAT,DDLNG(DDB) ; EXTEND UFD
PUSHJ P,SPREAD
MOVE TAC,[XWD -BKDSIZ,SYSDTA] ;RTVL OUT, JUST WRITE DATA!
MOVEM TAC,TFRIOW(DDB)
MOVE TAC,USETP(DDB)
PUSHJ P,LR2BLK
JUMPE TAC,[ POP P,TAC1 ;0 MEANS BAD RETRIEVAL!
JRST SETLOS]
PUSHJ P,BKMAP ;FINISH MAPPING
MOVEM TAC,TFRSEC(DDB)
POP P,TAC1
JRST DIRIHF
;*** I-SUBR TO READ DIRECTORY INTO SYSBUF & SEARCH.
;RETURNS FLAG IN SRCTMP: -1 IF NOT FOUND
; 0 IF DIFFERS IN EXT AND SPECIFIED EXT WAS 0
; +N IF EXACT MATCH FOUND
DIRSRC: MOVE TAC,SRCLOC(DDB) ;LOCATION OF UFD FILE
PUSHJ P,NEWFIL
SETZM SRCTMP(DDB)
PUSHJ P,GETBLK
MOVE TAC,DDPPN+SYSRTV ;BLOCK SHOULD LOOK LIKE UFD.
HLLZ TAC1,DDEXT+SYSRTV
CAMN TAC,SYSPPN
CAME TAC1,MFDEXT
PUSHJ P,AUDHAK ;IT DOESN'T.
MOVE TAC,MFDLOC
MOVE TAC1,SYSRTV+DSATID ;GET SATID OF CURRENT UFD.
CAMN TAC,SRCLOC(DDB) ;IS THIS THE MFD ?
CAMN TAC1,SATID ;YES. DOES ITS SATID AGREE
;WITH THE MASTER COPY ?
JRST DIRSA
EXCH TAC1,SATID ;MAKE IT GOOD, WE HOPE
PUSHACS
PUSHJ P,DISDATE
PUSHJ P,DISERR
[ASCIZ/SATID CLOBBERED!
SATID IN CORE=/]
DISARG(OCT,<-20+TAC1(P)>) ;SATID IN CORE
[ASCIZ/
SATID ON DISK=/]
DISARG(OCT,SATID)
[ASCIZ/
DON'T CONTINUE UNTIL YOU GET A WIZARD.
/]
-1
MOVE TAC,SATID ;MAKE SURE ALL THE SATID'S AGREE
MOVEM TAC,SATID1
MOVEM TAC,SATID2
CONO PI,PIOFF
SETOM DISFLAG ;FORCE TYPEOUT
PUSHJ P,DISFLUSH
POPACS
CONO PI,PION
PUSHJ P,DDTCALL ;MAKE HIM DO A CPOPJ$G
DIRSA: MOVE TAC1,SYSRTV+DQINFO+3 ;GET DEFAULT FILE PROTECTION
HLRM TAC1,UFDPR1(DDB) ;ICK!
MOVSI TAC1,777000
AND TAC1,SYSRTV+DDPRO
MOVEM TAC1,UFDPRO(DDB) ;SAVE PROTECTION OF THIS UFD
SETZ TAC1,
MOVN TEM,DDLNG+SYSRTV ;GET -WORD COUNT
JUMPE TEM,DIRSN ;EMPTY DIRECTORY
DIRS1: MOVEI TAC1,0
DIRS2: MOVE DAT,SYSDTA(TAC1)
CAME DAT,SRCNAM(DDB)
JRST DIRSX ;NOT THIS ONE
JUMPE DAT,DIRSRZ ;LOOKING FOR HOLE, FOUND ONE
MOVE DAT,SYSDTA+1(TAC1) ;NAME SAME, SAVE STUFF ...
MOVEM DAT,SRCTMP(DDB) ;FOR EXT CHECK.
MOVE TAC,SYSDTA+2(TAC1)
MOVEM TAC,SRCPRO(DDB)
MOVE TAC,SYSDTA+3(TAC1) ;FILE LOCN (MUST BE +)
MOVEM TAC,SRCLOC(DDB)
XOR DAT,SRCEXT(DDB) ;COMPARE EXTENSION
TLNN DAT,-1
JRST DIRSE ;MATCHES, THIS IS IT.
DIRSX: ADDI TEM,4 ;INDEXING.
ADDI TAC1,4
JUMPGE TEM,DIRSF ;OUT OF ENTRIES, RETURN FAIL.
CAIGE TAC1,BKDSIZ
JRST DIRS2
MOVEI TAC1,RCPBLK
ADDM TAC1,USETP(DDB)
PUSHJ P,GETBLK ;GET NEXT BLOCK OF DIRECTORY FILE
JRST DIRS1
DIRSF: SKIPN SRCTMP(DDB) ;ANY PARTIAL MATCH?
JRST DIRSN ;NO, RETURN FAIL
SKIPN SRCEXT(DDB) ;BLANK EXT SPECIFIED?
DIRSRZ: TDZA TAC,TAC ;RETURN MAYBE, IF SO.
DIRSN: SETOM TAC ;NO, RETURN FAILURE
DIRSE: EXCH TAC,SRCTMP(DDB) ;ENDFILE OR ENTRY FOUND
MOVEM TAC,SRCEXT(DDB) ;RETURN BEST BET
POPJ P,
; RETRIEVAL SUBRS
GETRET: MOVEI DAT,GGRETI ;GET RTVL IN IF IT IS NOT
PUSHJ P,TSTRET ;IS IT?
PUSHJ P,QEWAIT ;NO, GO GET IT
PUSHJ P,TSTRET ;IS IT REALLY HERE?
POPJ P, ;NO, GIVE ERROR RETURN
JRST CPOPJ1 ;YES, SUCCESS.
TSTRET: MOVE TAC,USETP(DDB) ;SKIP IF RTVL IS IN.
SKIPN TAC1,DGRP1R(DDB)
POPJ P, ;NOT IN, RETURN
CAIGE TAC,RCPGRP(TAC1)
CAIGE TAC,(TAC1)
POPJ P, ;LOSE, WRONG GROUP IN
JRST CPOPJ1 ;IN, SKIP
MAKBLK: PUSHJ P,GETRET ;GET GROUP RETRIEVAL IN!
PUSHJ P,ASNGRP ;NO SUCH GROUP, MAKE ONE
MOVE TAC,USETP(DDB)
PUSHJ P,LR2BLK ;LOOK UP BLOCK IN RTVL.
JUMPN TAC,CPOPJ ;IT EXISTS, RETURN
PUSHJ P,ASNBLK ;IT DOESN'T, GET ONE FROM SAT
TLO IOS,PNTDIF ;NOTE RTVL NOT OUT!!!
MOVE AC1,USETP(DDB) ;MAKE RTVL ENTRY
SUB AC1,DGRP1R(DDB) ;PUT ABS BLK PTR IN CORR HALFWD.
IDIVI AC1,RCPBLK
LSHC AC1,-1
ADDI AC1,DPTR(DDB)
JUMPL AC2,MAKB3
HRLM TAC,(AC1) ;EVEN IN LEFT HALF
POPJ P,
MAKB3: HRRM TAC,(AC1) ;ODD IN RIGHT HALF
POPJ P,
;ASSIGN A BLOCK FOR A NEW GROUP.
ASNGRP: PUSHJ P,ASNBLK ;GET BLOCK FROM SAT
ASNGR1: MOVEM TAC,DNXTGP(DDB) ;PUT INTO LINK
MOVEI DAT,SPREAD ;SMEAR EXISTING RTVL OUT...
SKIPE DGRP1R(DDB) ;IF THERE IS A CURRENT GROUP.
PUSHJ P,QEWAIT
SETZM TAC
EXCH TAC,DNXTGP(DDB) ;NEW BLOCK...
HRLZM TAC,DPTR(DDB) ;IS FIRST OF NEW GRP.
SETZM DPTR+1(DDB) ;CLEAR OUT REST OF RTVL.
HRLI TAC1,DPTR+1(DDB)
HRRI TAC1,DPTR+2(DDB)
BLT TAC1,DDEND-1(DDB)
MOVE TAC,USETP(DDB)
MOVEM TAC,DGRP1R(DDB)
TLO IOS,PNTDIF ;NOTE NEW RTVL NOT OUT.
POPJ P,
;SPREAD UPDATED RTVL OVER BLOCKS IN CURRENT GROUP.
;NORMALLY WRITES FROM DDB
SPREDT: MOVE AC2,USETP(DDB) ;OUT RTVL UP TO CURR BLOCK.
SUBI AC2,RCPBLK
JRST SPREDF
SPREAD: MOVE AC2,DGRP1R(DDB) ;OUT RTVL OVER WHOLE GROUP
ADDI AC2,RCPGRP-RCPBLK
SPREDF: MOVEI TAC1,DSKDAT(DDB)
SPREDD: HRLI TAC1,-SECSIZ
SKIPN TEM,DGRP1R(DDB)
POPJ P, ;NO RTVL TO SPREAD.
MOVEM TAC1,TFRIOW(DDB)
MOVEI TAC1,DWRITE!IOPDCH
MOVSM TAC1,TFRCTL(DDB)
SPREDL: CAMLE TEM,AC2
POPJ P, ;DONE WITH GROUP
SPREDR: MOVE TAC,TEM
PUSHJ P,LR2BLK
JUMPE TAC,SPREDI ;NON EX BLOCK
PUSHJ P,BK2SEC
MOVEM TAC,TFRSEC(DDB)
PUSHJ P,TSTART
SPREDI: ADDI TEM,RCPBLK
JRST SPREDL
AUDINF: MOVSI TAC1,FILNAM(DDB)
HRRI TAC1,DSKDAT(DDB) ;BLT AUDIT INFO INTO RTVL
BLT TAC1,DSKDAT+7(DDB)
MOVE TAC1,SATID
MOVEM TAC1,DSATID(DDB)
POPJ P,
AUDCHK: MOVE TAC,FILNAM(DDB)
CAME TAC,DDNAM(DDB)
TLO IOS,LOSBIG
HLLZ TAC,FILEXT(DDB)
HLLZ TAC1,DDEXT(DDB)
CAME TAC,TAC1
TLO IOS,LOSBIG
MOVE TAC,FILPPN(DDB)
CAME TAC,DDPPN(DDB)
AUDHAK: TLO IOS,LOSBIG
TLNE IOS,LOSBIG
MOVEM DDB,ACDDB ;SAVE LOSER FOR DEBUGGING
POPJ P,
;SET UP GGRETI TO READ A NEW FILE, WHOSE RTVL ISN'T IN.
NEWFIL: CAME TAC,DDLOC(DDB) ;IS RIGHT RTVL IN?
NEWFI1: SETZM DGRP1R(DDB) ;NO, FORCE IT TO BE READ
MOVEM TAC,DDLOC(DDB)
MOVEI TAC1,1
MOVEM TAC1,USETP(DDB)
POPJ P,
; GET BLOCK CONTAINING USETP INTO SYSBUF.
GETBLK: PUSHJ P,GGRETI ;GET RTVL IN
JUMPE TAC,CPOPJ ;NON EX=EOF
MOVE TAC,USETP(DDB)
SKIPN TFRIOW(DDB) ;DID GGRETI READ?
JRST GETBK1 ;NO, GO READ BLOCK
MOVE TAC1,DGRP1R(DDB) ;FIRST GROUP OF BLOCK
CAIGE TAC,RCPBLK(TAC1) ;IS ONE WE WANT IN IN THIS BLOCK?
POPJ P, ;YES, RETURN.
GETBK1: PUSHJ P,LR2BLK
JUMPE TAC,CPOPJ ;NON EX = EOF
PUSHJ P,BK2SEC
MOVEM TAC,TFRSEC(DDB) ;READ IT INTO SYSBUF
MOVE TAC,BUFIOW
MOVEM TAC,TFRIOW(DDB)
MOVEI TAC,IOPCHN
MOVSM TAC,TFRCTL(DDB)
PUSHJ P,TSTART
POPJ P,
; GET RTVL FOR GROUP INTO DDB IF NOT ALREADY THERE.
GGRETI: SETZM TFRIOW(DDB) ;FLAG FOR GETBLK.
SKIPN TAC1,DGRP1R(DDB) ;IF NO RTVL IN,
JRST GGBLK1 ;GET BLOCK 1.
MOVE TAC,USETP(DDB)
CAIL TAC,RCPGRP(TAC1) ;USETP IN CURRENT GROUP?
JRST GGNXT ;BEYOND, TRY SUCCESSOR
CAIL TAC,(TAC1)
POPJ P, ;IN THIS ONE.
GGBLK1: SKIPA TAC,DDLOC(DDB) ;START AT BEGINNING.
GGNXT: MOVE TAC,DNXTGP(DDB) ;GO ON TO NEXT GROUP
JUMPE TAC,CPOPJ ;RETURN IF EOF
PUSHJ P,BK2SEC
MOVEM TAC,TFRSEC(DDB)
MOVE TAC,BUFIOW ;READ ENTIRE BLOCK...
MOVEM TAC,TFRIOW(DDB)
MOVEI TAC,IOPCHN
MOVSM TAC,TFRCTL(DDB)
PUSHJ P,TSTART ;IN CASE SOMEONE WANTS IT.
HRLI TAC,SYSBUF ;GOT CORRECT GRP. BLT RTVL
HRRI TAC,DSKDAT(DDB) ;AND AUDIT TO DDB.
BLT TAC,DSKDAT+SECSIZ-1(DDB)
MOVE TAC,USETP(DDB)
MOVE TAC1,DGRP1R+SYSRTV
CAIL TAC,RCPGRP(TAC1) ;IN THIS GROUP?
JRST GGNXT
POPJ P,
;LOGICAL RECORD TO BLOCK. CORRECT GROUP IS ASSUMED.
LR2BLK: SUB TAC,DGRP1R(DDB)
CAIL TAC,0
CAIL TAC,RCPGRP
MOVEI TAC,1 ;WRONG GROUP.DEFAULT SELECT REC1.
IDIVI TAC,RCPBLK
MOVEI AC3,1(TAC1) ;PHYSICAL RECORD WITHIN BLOCK (INCL RTRVL)
LSHC TAC,-1
ADDI TAC,DPTR(DDB)
MOVE TAC,(TAC)
SKIPL TAC1
HLRS TAC
HRRZS TAC
POPJ P,
;CONVERT BLOCK NO. TO DISK ADDRESS OF FIRST RECORD OF BLOCK
BK2SEC: SETZ AC3,
;MAPPING BLOCK NO. AND RECORD NO. TO DISK ADDRESS
BKMAP: LSH TAC,6 ;TO STOP LATER.
ANDI AC3,77 ;IGNORE IMPOSSIBLE RECORD NOS.
IOR TAC,AC3
POPJ P,
↑DSKRES:MOVEI TAC,LSTBIT-=200 ;CALC DSK RESOURCES. FROM TOTAL,
SUB TAC,DSKUSE ;LESS THOSE IN USE, YOU HAVE..
JUMPGE TAC,CPOPJ
MOVEI TAC,0 ;WOULD YOU BELIEVE..NONE?
POPJ P,
; SAT TABLE OPERATIONS
CUSATO: SKIPN SATFLG ;SAT OUT FROM UUO LEVEL, IF CHANGED.
POPJ P, ;NO CHANGE, RETURN
MOVE TAC,TIME ;GET CURRENT TIME
MOVEM TAC,DTIME ;SAVE IN SAT TABLE
MOVE TAC,THSDAT
MOVEM TAC,DDATE ;AND CURRENT DATE
MOVEI DAT,SATOUT
JRST NENTER ;QUEUE THIS AND POPJ
SATOUT: SKIPA TAC,[DWRITE!IOPCHN] ;WRITE SAT
SATIN: MOVEI TAC,IOPCHN ;READ SAT
TLO IOS,SATOP
MOVSM TAC,TFRCTL(DDB)
MOVE TAC,[XWD -SATSIZ,SATTAB]
MOVEM TAC,TFRIOW(DDB) ;IOWD FOR THIS TRANSFER
SETZM TFRSEC(DDB)
PUSHJ P,TSTART
SETZM SATFLG
TLZ IOS,SATOP
POPJ P,
ASNBLK: PUSHJ P,IASNBK ;ASSIGN SUITABLE BLOCK
PUSH P,TAC
MOVEM TAC,TFRSEC(DDB) ;SAVE HERE FOR I SUBR
MOVEI DAT,RB4WCK ;READ BEFORE WRITE CHECKER
PUSHJ P,QEWAIT
POP P,TAC
SKIPN TFRIOW(DDB) ;SUCCESS?
JRST ASNBLK ;NO, ASSIGN ANOTHER BLOCK
POPJ P,
; READ BEFORE WRITE CHECKER ** I SUBR
RB4WCK: SKIPN TAC,TFRSEC(DDB) ;GET LOGICAL DISK ADDRESS
JRST RB4WLS ;LOSE IF ADDRESS IS 0
PUSHJ P,BK2SEC ;CONVERT TO PHYSICAL ADDRESS
MOVEM TAC,TFRSEC(DDB) ;AND PUT IT BACK
MOVE TAC,[XWD -SECSIZ,QBUF]
MOVEM TAC,TFRIOW(DDB)
MOVEI TAC,IOPCHN
MOVSM TAC,TFRCTL(DDB) ;READ OP
PUSHJ P,TSTART
MOVE IOS,DEVIOS(DDB)
TRNE IOS,IODERR!IODTER ;LOSE ON READ?
JRST RB4WER ;YES, USE ANOTHER
SKIPE QBUF+DDNAM-DSKDAT ;NULL FILE NAME?
SKIPN QBUF+DDPPN-DSKDAT ;OR PPN?
POPJ P, ;YES, OK TO WRITE HERE
MOVE TAC,SATID ;GET SATID FROM CORE
CAME TAC,QBUF+DSATID-DSKDAT ;SAME AS ON DISK?
POPJ P, ;NO. INVALID SATID MEANS WE CAN WRITE HERE
RB4WLS: AOS DSKOVC ;COUNT OVERWRITE CHECK
RB4WER: SETZM TFRIOW(DDB) ;FLAG ILLEGAL BLOCK
POPJ P,
;IASNBK
;THIS CODE BLOWS HORNY TOADS, SOMEONE OUGHT TO FIX IT. - REG
ASNST1: CONO PI,IOPON ;TURN IOP BACK ON
PUSHJ P,EDFULL ;"DISK IS FULL" MESSAGE
;LET HIM TRY AGAIN, IF HE SAYS CONTINUE
IASNBK: MOVE AC2,LSTBLK ;LAST PLACE WE ASSIGNED BLOCK
AOJA AC2,ASNSL2 ;START BEYOND THAT
ASNSL1: CONO PI,IOPON ;LET THE IOP IN FOR A QUICK LOOK.
ASNSL2: CONO PI,IOPOFF
CAIL AC2,LSTBIT ;OFF THE END YET?
MOVEI AC2,1 ;YES. START OVER.
CAMN AC2,LSTBLK ;WRAP TO WHERE WE STARTED?
JRST ASNST1 ;YES. ICK. THERE'S NO DISK LEFT
MOVE TAC,AC2 ;CONVERT BLOCK NUMBER TO BIT AND WORD #
IDIVI TAC,44 ;WORD NUMBER IN TAC, BIT NUMBER IN TAC1
MOVEI AC1,1 ;MAKE A BIT MASK
ROT AC1,(TAC1)
TDNE AC1,SATBIT(TAC) ;THIS BLOCK IN USE?
AOJA AC2,ASNSL1 ;YES, KEEP LOOKING
SETOM SATFLG ;FLAG SAT TABLE IS BEING CHANGED
IORM AC1,SATBIT(TAC) ;MARK IN USE
XORM AC1,SATCHK ;UPDATE CHECKSUM.
CONO PI,IOPON ;LET THEM BACK IN
MOVEM AC2,LSTBLK ;REMEMBER THE LAST BLOCK THAT WAS USED
AOS TAC,AC2 ;RETURN EXCESS 1 IN TAC. (AVOID 0)
AOS DSKUSE ;COUNT ANOTHER BLOCK IN USE
SKIPG AC1,BADCNT
POPJ P,
CAILE AC1,BADMAX
MOVEI AC1,BADMAX
CAMN TAC,BADTRK-1(AC1) ;SKIP UNLESS THIS BLOCK IS BAD
JRST IASNBK ;ASSIGN SOME OTHER BLOCK.
SOJG AC1,.-2
POPJ P,
RTNBLK: CAIG TAC,LSTBIT ;SKIP IF INVALID BLOCK.
SOJGE TAC,.+2 ;REMOVE EXCESS 1 AND JUMP IF VALID
POPJ P, ;INVALID BLOCK
IDIVI TAC,44
MOVEI AC1,1
ROT AC1,(TAC1)
TDNN AC1,SATBIT(TAC)
POPJ P, ;ALREADY OFF!
ANDCAM AC1,SATBIT(TAC)
XORM AC1,SATCHK ;UPDATE CHECKSUM.
SOS DSKUSE ;DECREASE COUNT
SETOM SATFLG ;FLAG SAT TABLE NEEDS OUTPUT
POPJ P,
↓MRKBLK:CAIG TAC,LSTBIT
SOJGE TAC,.+2
POPJ P,
IDIVI TAC,44
MOVEI AC1,1
ROT AC1,(TAC1)
TDNE AC1,SATBIT(TAC)
POPJ P,
IORM AC1,SATBIT(TAC)
XORM AC1,SATCHK
AOS DSKUSE
SETOM SATFLG
POPJ P,
;DELETE A FILE, FREE DISK BLOCKS
DELETE: PUSHJ P,NEWFIL ;SET UP RTVL FETCH
MOVEI DAT,DELFIL
MOVE AC1,FILLNG(DDB)
CAILE AC1,=50*2000
JRST NEWAIT ;MARK ALL BLOCKS EMPTY, CLEAR RTVL
JRST QEWAIT
;*** INTERRUPT SUBR ***
DELFIL: PUSHJ P,DELBLK
TRZE IOS,IODTER ;WAS THERE AN ERROR ?
JRST DSIOS
MOVE TAC,USETP(DDB)
DELF2: PUSHJ P,LR2BLK ;RETURN BLOCKS TO SAT
JUMPE TAC,.+2 ;NO SUCH BLOCK
PUSHJ P,RTNBLK
MOVEI TAC,RCPBLK
ADDB TAC,USETP(DDB)
MOVE TAC1,DGRP1R(DDB)
CAIGE TAC,RCPGRP(TAC1) ;HAVE WE GOT TO NXT GRP?
JRST DELF2 ;STILL IN THIS ONE, CONTINUE
DELF3: SKIPE DNXTGP(DDB) ;IS THERE A NEXT GROUP?
JRST DELFIL ;YES, DO IT
POPJ P,
DELBLK: PUSHJ P,GGRETI ;GET INTO CORE
PUSHJ P,AUDCHK
TLZE IOS,LOSBIG
JRST DELBK1
LDB AC2,PJOBN ;GET JOB # OF LOSER DELETING FILE
MOVE AC1,JOBNAM(AC2) ;NOW REMEMBER SOMETHING ABOUT HIM
MOVEM AC1,DQINFO+2(DDB)
MOVE AC1,PRJPRG(AC2)
MOVEM AC1,DQINFO+3(DDB)
SETZM DSATID(DDB) ;JUST CLEAR SATID TO FREE THIS BLOCK
JRST SPREAD ;AND POOT IT BACK OUT
DELBK1: TRO IOS,IODTER
JRST DSIOS
; SWAPPER INTERFACE
; EXTERNAL SERACT,JOBDAC,MJOBCK,FINISH,JBTCHK,SERA
; INTERNAL DFWRT,DFRED
;ENTER HERE FROM SWAPPER TO START SWAP (DISK IDLE.)
;TAC=DISK ADDR=SERA; TAC1=IOWD=SQREQ.
↑DFWRT:
↑DFRED: CONO PI,IOPOFF ;JUST FOR SAFETY.
PUSHJ P,DSSTRT
MOVSI 17,UUOACS ;RETURN HERE AFTER STARTING XFER
BLT 17,17 ;RELOAD CH7 AC'S (ESP. P)
CONO PI,IOPON ;SAFE NOW
POPJ P, ;GO TO SWPXIT
DSSTRT: POP P,INTRTN
JSR DSKSV ;SET UP CH6 PDL.
PUSHJ P,SQGOX1 ;RETURNS HERE WHEN XFER DONE
JRST DNSTR1 ;GO DO NEXT I-SUBR.
;ENTER HERE FROM DISK QUEUE SERVICE AFTER FINISHING I-SUBR.
SQGOA: MOVEI TAC1,TRIES
MOVEM TAC1,SERACT
MOVSI TAC,200000 ;PUT IN A BIT...
ORB TAC,SERA ;TO INDICATE SWAP OP.
MOVE TAC1,SQREQ
MOVM J,FINISH
HRRO J,J ;NEG TO INDICATE SWAPPER
PUSHJ P,SQGOX ;DO SWAP OP.
JRST DNSTR1 ;GO DO NEXT I-SUBR.
;SET UP SWAP OPERATION AND EXECUTE IT.
;ENTER WITH TAC=DISK ADDR=SERA; +1B0 IF INCOMING.
;TAC1=IOWD=SQREQ.
SQGOX1: ADDI TAC1,1 ;CONVERT IOWD TO 167 FORMAT
SQGOX: MOVE DDB,SWPDDB ;GET THE RIGHT DDB
MOVEM TAC1,TFRIOW(DDB)
MOVEI DAT,IOPCHN
SKIPL SERA
TRO DAT,DWRITE
MOVSM DAT,TFRCTL(DDB)
PUSHJ P,SBK2SC ;SPECIAL BLOCK TO SECTOR
MOVEM TAC,TFRSEC(DDB)
SQGO2: SETZB IOS,DEVIOS(DDB) ;MAKE SURE THERE ARE NO ERROR BITS ON!
PUSHJ P,SETACT
PUSHJ P,TGO ;ZORCH
MOVEI IOS,IOACT
ANDCAB IOS,DEVIOS(DDB)
TRNE IOS,IOIMPM ;IMMEDIATE ERROR?
JRST SWPLUZ
TRNE IOS,IODERR!IODTER
JRST SWPERR
JRST SNOERR ;NO ERRORS
SWPLUZ: PUSHACS
PUSHJ P,DISMES
ASCIZ /SWAPPING PACK OFF LINE OR IN WRITE LOCK!
PLEASE FIX IT AND CONTINUE.
/
SETOM DISFLAG
PUSHJ P,DISFLUSH
POPACS
HALT SQGO2
SWPERR: SOSLE SERACT ;COUNT DOWN
JRST SQGO2 ;TRY AGAIN
TRO IOS,IODERR ;TRIED ENOUGH, DIE
SNOERR: MOVE TAC,IOS
ANDI TAC,IODERR!IODTER ;GET ERROR BITS, IF ANY.
MOVEM TAC,SERA ;GIVE TO SWAPPER.
SETZM SQREQ
SETZM SWPCNT ;WAKE UP SWAPPER.
POPJ P,
;MORE MISC: CONVERT SWPSER BLOCK ADDRESS TO DISC ADDRESS.
;COURTESY J. SAUTER
SBK2SC: HRRZ TAC,TAC
IDIVI TAC,1140 ;↑D1216/2
LSH TAC,14 ;MAKE BAND NO.
TLO TAC,400000 ;INDICATE SWAP OP
POPJ P,
;ENTER HERE FOR HIGH PRIORITY TRANSFER (CURRENTLY ONLY UDP IO).
UEWAIT: TDZE IOS,[XWD DEVSBB,IOACT]
PUSHJ P,WSYNC
MOVSI AC1,DEVIBF
ANDCAM AC1,DEVCMR(DDB)
PUSHJ P,SETACT
SKIPN UPTR ;THIS HAD BETTER BE 0
JRST UE2 ;OK
PUSHACS
PUSHJ P,DISDATE
PUSHJ P,DISERR
[ASCIZ/UPTR NON-ZERO AT UEWAIT!
UPTR = /]
DISARG OCT,UPTR
[ASCIZ/
/]
-1
SETZM UPTR
SOS DQCNT
UE2: CONO PI,IOPOFF ;ENTERING CRITICAL SECTION
MOVEM DAT,UPTR
AOS DQCNT ;COUNT SOMEONE NEW INTO DISK QUEUE
HRLM DDB,UPTR
PUSHJ P,UE1 ;MERGE WITH Q-ENTER CODE
JRST WSYNC ;AND WAIT FOR FINISH
;ENTER I-SUBR CALL IN QUEUE FROM UUO LEVEL.
QEWAIT: PUSHJ P,QENTER ;PUT REQUEST IN QUEUE
JRST WSYNC ;WAIT FOR IT TO FINISH
QENTER: TDZE IOS,[XWD DEVSBB,IOACT]
PUSHJ P,WSYNC ;JUST IN CASE SOMEBODY GOOFED.
MOVSI AC1,DEVIBF
ANDCAM AC1,DEVCMR(DDB)
PUSHJ P,SETACT ;STORES IOS
QE1: SKIPE @MIPTR
JRST .-1 ;CRASH IF QUEUE FULL
CONO PI,IOPOFF ;INTS OFF UNTIL IACTIV:
HRLM DDB,@MIPTR ;DDB ADDR...
HRRM DAT,@MIPTR ;AND SUBROUTINE ADDR.
AOS DAT,MIPTR ;BUMP QUEUE POINTER
AOS DQCNT ;ANOTHER LOSER INTO QUEUE
MOVE AC1,-1(P) ;MAKE LOG ENTRY
HRL AC1,DDB
MOVEM AC1,LBEGIN-QBEGIN-1(DAT)
CAIL DAT,QEND
MOVEI DAT,QBEGIN
MOVEM DAT,MIPTR
SETZM LBEGIN-QBEGIN(DAT)
UE1: MOVNI DAT,1
EXCH DAT,DFBUSY
JUMPN DAT,IACTIV ;RETURN IF INT PGM RUNNING.
PUSHJ P,DIGO ;SAVE UUO AC'S, START I-LEVEL
INSRTN: MOVSI 17,UUOACS ;RELOAD UUO AC'S FROM INT. SAVE.
BLT 17,17 ;CH6 INTS INHIBITED UNTIL THIS DONE.
IACTIV: CONO PI,IOPON
POPJ P, ;RETURN TO UUO CALLER.
NEWAIT: PUSHJ P,NENTER
JRST WSYNC
NENTER: TDZE IOS,[XWD DEVSBB,IOACT]
PUSHJ P,WSYNC
MOVSI AC1,DEVIBF
ORM AC1,DEVCMR(DDB)
TLO IOS,DEVSBB
MOVEM IOS,DEVIOS(DDB)
JRST QE1
;RETURN HERE FROM TSTART WITH I-AC'S SAVED.
DIGO: POP P,INTRTN ;ARRANGE I-LEVEL DISMISS
JSR DSKSV ;SAVE UUO AC'S IN CH6 AREA. MUST NOT HAVE
;CH6 INTERRUPT UNTIL THESE ARE RESTORED.
;SET UP I-LEVEL PDL (OTHER AC'S NOT NEEDED)
JRST DNSTRT ;GO CALL SUBR
;I-LEVEL SUBRS RETURN HERE WHEN DONE TO START ANOTHER REQUEST.
DNXTRQ: SETZM @MOPTR ;WIPE OUT RQ JUST FINISHED
AOS TAC,MOPTR ;ADVANCE POINTER
SOS DQCNT ;ONE LESS LOSER IN QUEUE
CAIL TAC,QEND
MOVEI TAC,QBEGIN
MOVEM TAC,MOPTR
DNSTRT: SKIPN TAC,UPTR ;ANY UDP REQUEST?
JRST DNSTRU ;NO, CHECK SWAPPER
PUSHJ P,DSETUP ;CALL COMMON SETUP AND DISPATCH
SETZM UPTR ;CLEAR REQUEST CELL
SOS DQCNT
DNSTRU: SKIPE SQREQ ;IF SWAPPER WANTS SOMETHING,
JRST SQGOA ;GO SEE ABOUT IT.
DNSTR1: SKIPN TAC,@MOPTR ;GET NEXT REQUEST.
JRST DFSTOP ;NONE PENDING, FLAG IDLE
PUSHJ P,DSETUP ;COMMON SETUP AND DISPATCH
ISRTN: JRST DNXTRQ
DSETUP: HLRZ DDB,TAC
SETZB PROG,BKIN ;FLAG SYSBUF EMPTY
MOVE IOS,DEVIOS(DDB)
LDB J,PJOBN
MOVSI AC1,DEVIBF
TDNE AC1,DEVCMR(DDB)
JRST DNSTR2
TLZE IOS,DEVSBB
PUSHJ P,MESS2
SKIPE J
SKIPE PROG,JBTADR(J)
TRON IOS,IOACT
PUSHJ P,MESS3
JRST DNSTR3
DNSTR2: TRZE IOS,IOACT
PUSHJ P,MESS4
TLON IOS,DEVSBB
PUSHJ P,MESS5
DNSTR3: PUSHJ P,(TAC) ;CALL SUBR
DRQDN: MOVSI AC1,DEVIBF
ANDCAM AC1,DEVCMR(DDB)
TDZN IOS,[XWD DEVSBB,IOACT] ;MOST SUBRS POPJ, THEN
PUSHJ P,MESS1 ;IOACT OFF AT....
TLZE IOS,IOW ;DO THIS RITUAL TO...
PUSHJ P,SETIOD ;GET OUT OF IO WAIT
JRST DSIOS ;STORE IOS!
DFSTOP: SETZM DFBUSY
JRST @INTRTN ;RESTORE USER AC'S, DISMISS
MESS1: PUSHACS
PUSHJ P,DISDATE
PUSHJ P,DISMES
ASCIZ/IOACT OFF AT DRQDN.
/
POPACS
JRST DSIOS
MESS2: PUSHACS
PUSHJ P,DISDATE
PUSHJ P,DISMES
ASCIZ/DEVIBF OFF BUT DEVSBB ON AT DNSTRT.
/
POPACS
JRST DSIOS
MESS3: PUSHACS
PUSHJ P,DISDATE
PUSHJ P,DISMES
ASCIZ/IOACT OFF AT DNSTRT.
/
POPACS
JRST DSIOS
MESS4: PUSHACS
PUSHJ P,DISDATE
PUSHJ P,DISMES
ASCIZ/DEVIBF AND IOACT ON AT DNSTRT.
/
POPACS
JRST DSIOS
MESS5: PUSHACS
PUSHJ P,DISDATE
PUSHJ P,DISMES
ASCIZ/DEVIBF ON BUT DEVSSB OFF.
/
POPACS
JRST DSIOS
;I-LEVEL SUBRS PUSHJ HERE TO START A TRANSFER.
TSTART: MOVEI TAC,TRIES
HRRM TAC,TFRCTL(DDB)
TREDO: PUSHJ P,TGO
TFSRTN: TRNN IOS,IODERR!IODTER ;ANY ERRORS?
POPJ P, ;NO, OK RETURN.
SOS TAC,TFRCTL(DDB) ;COUNT DOWN
TRNE TAC,-1 ;TRIED ENOUGH?
JRST TREDO ;NO, TRY AGAIN.
TLO IOS,LOSBIG ;INFORM THE HIGHER-UPS.
POPJ P, ;RETURN LOSSAGE.
TGO: MOVEM DDB,DXB
MOVEM J,DXJ
MOVEM P,DXP
TRZ IOS,IODERR!IODTER ;WE HAVEN'T LOST YET.
MOVE TAC,TFRSEC(DDB)
MOVEM TAC,DXS
MOVE TAC,TFRIOW(DDB)
MOVEM TAC,DXW
HLRZ TAC,TFRCTL(DDB)
MOVEM TAC,DXC
JRST GO2314
SUBTTL ERROR HANDLING
;ERRORS, CLASS 1. ENTER, ETC. RETURN CODES IN E+1
ENOUFD: POP P,TAC ;ADJUST STACK
POP P,TAC
JRST ENOUF1
ENOFIL: JSP TAC,ERRC1 ;0 - ZERO FILE NAME
ENOUF1: JSP TAC,ERRC1 ;1 - NO UFD
EPROT: JSP TAC,ERRC1 ;2 - PROTECT VIOLATION
EFWRIT: JSP TAC,ERRC1 ;3 - FILE BEING WRITTEN
EDNAME: JSP TAC,ERRC1 ;4 - NAME IN USE
EXFIL: JSP TAC,ERRC1 ;5 - NO LOOKUP OR ENTER - RENAME
EANAME: JSP TAC,ERRC1 ;6 - ENTER (ALTER) NAME DISAGREES
ENODEV: JSP TAC,ERRC1 ;7 - NO DEVICE (NO INIT)
EGARB1: JSP TAC,ERRC2 ;10 - GARBAGED UFD (POINTER OUT OF RANGE)
EGARB2: JSP TAC,ERRC2 ;11 - GARBAGED FILE (POINTER WRONG)
EFULLZ: JSP TAC,ERRC1 ;12 - DISK IS FULL, TRY AGAIN LATER
ERRC2: TRNN IOS,GARBIT ;SUPPRESS "BAD RTVL" MESSAGE??
JRST EGARB ;NO. NOT A SPECIAL PERSON.
PUSHJ P,ERZIOS ;HOLD ALL FURTHER I/O.
ERRC1: SUBI TAC,ENOFIL+1 ;GET ERROR CODE
XCTR XRW,[HRRM TAC,ERRBOX(UUO)] ;STUFF ERROR CODE
ANDI TAC,-1
CAIE TAC,11 ;ALLOW RENAME OF FILE WITH BAD RETRIEVAL
SETZM FILNAM(DDB) ;DISABLE RENAME.
JRST ERZIOS ;DISABLE I/O. DOES NOT RETURN.
;ERRORS, CLASS 2. FLUSH USER, GO TO SYSTEM.
ENTFUL: PUSHJ P,EFULLZ ;GIVE FUNNY ERROR CODE
TRNE IOS,GARBIT ;IS HE ENABLED FOR DIRECT RETURN?
POPJ P, ;YES. DO IT
EDFULL: PUSH P,IOS ;SAVE THE RELEVANT ACS
PUSHJ P,DPOPJ ;CLEAR GOBIT IF SET AND SAVE ITS STATE
PUSH P,DDB
PUSHJ P,TTYFUW ;FIND TTY
PUSHJ P,INLMES
ASCIZ /
DISK IS FULL!/
PUSHJ P,PRCRCC ;TYPE CRLF ↑C
PUSHJ P,TTYSTC ;SET TTY INTO COMMAND MODE.
PUSHJ P,STOP1 ;STOP THE JOB
POP P,DDB
POP P,IOS ; RESTORE THE ACCUMULATORS
POPJ P, ; AND RETURN TO SENDER.
ENOENT: JSP TAC,ERRPTU
ASCIZ /NEED ENTER BEFORE OUTPUT/
JRST EXCALP
ENOLUK: JSP TAC,ERRPTU
ASCIZ /NEED LOOKUP BEFORE INPUT/
JRST EXCALP
ELOSE: JSP TAC,ERRPTU
ASCIZ /ERROR IN DSKSER/
JRST EXCALP
EGARJ2: POP P,TAC
EGARPJ: POP P,TAC ;FIX UP STACK
EGARB: PUSHJ P,ERZIOS ;HOLD ALL I/O.
TRNE IOS,IODTER!IODERR ;MACHINE OR DATA ERRORS?
JRST EGARC ;2314 SCREW-UP
JSP TAC,ERRPTU
ASCIZ /BAD RETRIEVAL/
JRST EXCALP
EGARC: JSP TAC,ERRPTU
ASCIZ /DISK TRANSMISSION ERROR/
JRST EXCALP
EACMFD: JSP TAC,ERRPTU
ASCIZ /CAN'T ENTER-RENAME MFD/
JRST EXCALP
EDMPLS: JSP TAC,ERRPTU
ASCIZ /ILLEGAL FORMAT DUMP MODE COMMAND LIST/
JRST EXCALP
ERZIOS: TLZ IOS,GOBIT!LOSBIG!READB!WRITEB!ALTERB
JRST DPOPJ ;TUCK IOS AWAY. DON'T LET USER DO ANYTHING.
; USER DISK PACK SERVICE
UDPINI: ;INITIALIZE IOS FOR EACH UDP
FOR @$ UNUM←0,UPACKS-1
< SETZM UDP$UNUM$DD+DEVIOS
>
POPJ P,
;DISPATCH TABLE - DISTINGUISH BETWEEN OLD-SYTLE AND NEW STYLE UDP UUOS
UDPDS1: MOVEI TAC,-UDPDSP-1(TAC) ;TAC←INDEX TO UDPSD2 OR TO DSKDSP
TRNE IOS,100 ;100 BIT ON FOR OLD STYLE UDP UUOS.
JRST UDPDS2(TAC) ;DISPATCH TO OLD STYLE
JUMPN TAC,UUOERR
JRST ERZIOS
JRST DSKDSP(TAC) ;DISPATCH TO NEW STYLE
JRST UDPINI ;INITIALIZE
JRST DHUNG ;HUNG TIMEOUT
↑UDPDSP:JSP TAC,UDPDS1 ;RELEASE
JSP TAC,UDPDS1 ;CLOSE OUTPUT
JSP TAC,UDPDS1 ;BUFFERED OUTPUT
JSP TAC,UDPDS1 ;BUFFERED INPUT
JSP TAC,UDPDS1 ;ENTER
JSP TAC,UDPDS1 ;LOOKUP
JSP TAC,UDPDS1 ;DUMP OUTPUT
JSP TAC,UDPDS1 ;DUMP INPUT
JSP TAC,UDPDS1 ;USETO
JSP TAC,UDPDS1 ;USETI
JSP TAC,UDPDS1 ;UGETF
JSP TAC,UDPDS1 ;RENAME
JSP TAC,UDPDS1 ;CLOSE INPUT
JSP TAC,UDPDS1 ;UTPCLR
JSP TAC,UDPDS1 ;MTAPE
UDPDS2: JRST ERZIOS ;RELEASE, DISABLE WRITE
JRST ERZIOS ;CLOSE OUTPUT, SAME
JRST UUOERR ;BUFFERED OUTPUT
JRST UUOERR ;BUFFERED INPUT
JRST PASSIT ;ENTER, CHECK PASS WORD
JRST UUOERR ;LOOKUP
JRST UDPOUT ;DUMP OUTPUT
JRST UDPIN ;DUMP INPUT
JRST UUOERR ;USETO
JRST UUOERR ;USETI
JRST UUOERR ;UGETF
JRST PASSET ;RENAME, SET PASS WORD
POPJ P, ;CLOSE INPUT
POPJ P, ;UTPCLR
JRST UUOERR ;MTAPE
UDPIN: MOVEI TAC1,IOPCHN
JRST UDPSER
UDPOUT: TLNN IOS,WRITEB ;ENTER DONE?
JRST ENOENT ;NO
MOVEI TAC1,DWRITE!IOPCHN
UDPSER: MOVSM TAC1,TFRCTL(DDB)
HRRZ AC1,UUO ;CHECK EVERY ADDRESS IN SIGHT.
PUSHJ P,UADCK1 ;FOR LEGAL ADDRESS RANGE.
ADDI AC1,1
PUSHJ P,UADCK1 ;CHECK LAST CL WORD TOO.
XCTR XR,[SKIPL (UUO)] ;THIS IS BECAUSE DMPCMD DOES BRANCHING!
JRST ADRERR ;ONLY IOWD'S ALLOWED
PUSHJ P,DMPCMD ;CHECK FOR LEGAL IOWD
MOVEM TAC1,CORFAD(DDB)
XCTR XR,[MOVE TAC1,(UUO)] ;GET IOWD
LDB DAT,PSEGN ;UPPER (IF ANY)
JUMPE DAT,UDPS1 ;NONE, MUST BE IN LOWER
HRRZ DAT,JBTADR(DAT) ;RELOC OF UPPER
TRZN TAC1,400000 ;IN UPPER?
UDPS1: HRRZ DAT,PROG ;AFTER ALL THAT ITS IN THE LOWER
ADDI TAC1,1(DAT) ;RELOCATE AND MAKE IT XWD -WC,ADDRESS
MOVEM TAC1,TFRIOW(DDB) ;GOD ONLY KNOWS WHAT MCGUIRE WILL DO WITH THIS
XCTR XR,[HRRZ TAC1,1(UUO)] ;GET UDP BLOCK ADDR.
LDB DAT,PUNIT
LDB DAT,[POINT 32,NCYLSH+FPACKS(DAT),31] ;NUMBER OF CYLS ON THIS PACK
IMULI DAT,BKPTRK*TRKCYL ;MULTIPLY TO GET TOTAL NUMBER OF BLOCKS
CAIL TAC1,(DAT) ;TOO BIG?
JRST UADRER ;NO GOOD.
MOVE TAC,JBTPRV(J)
TLNN TAC,UDPPRV ;LET DUMPER(1,2) GET AT LAST BLOCK
CAIE TAC1,-1(DAT) ;LAST LOGICAL BLOCK
CAIA
JRST UADRER
ADD TAC1,UDPOFF(DDB) ;KLUGE UP START ADDR OF UDP.
LSH TAC1,6 ;PRETEND RECORD ZERO.
XCTR XR,[HLRZ TAC,1(UUO)]
CAILE TAC,RCPBLK ;LEGAL RECORD NUMBER?
JRST UADRER
IOR TAC1,TAC ;OR IT IN
MOVEM TAC1,TFRSEC(DDB)
PUSHJ P,GOSET
SETOM DDLOC(DDB)
MOVEI DAT,TSTART
PUSHJ P,UEWAIT
SETZM DDLOC(DDB)
JRST DPOPJ
;UDP PASS WORD STUFF
PASSIT: MOVE TAC,JBTPRV(J)
TLNE TAC,UDPPRV ;LET DUMPER THROUGH (1,2)
JRST PASSI1
TLZ IOS,WRITEB ;LOSE FOR NOW
MOVEI DAT,PASSIN ;READ PASSWORD BLOCK
PUSHJ P,NEWAIT
TRNE IOS,IODERR!IODTER ;ERRORS?
JRST EGARB1 ;YES
MOVE TAC,['PASS '] ;CHECK FOR INITIALIZATION
CAMN TAC,DSKDAT(DDB)
CAME TAC,DSKDAT+1(DDB)
JRST PASSI1 ;NOT INITIALIZED, LET HIM IN
XCTR XR,[MOVE TAC,(UUO)] ;GET PASS WORD FROM USER
SKIPE DSKDAT+2(DDB) ;MAY NOT BE NECESSARY
CAMN TAC,DSKDAT+2(DDB) ;SAME PASS WORD?
CAIA ;YES
JRST EPROT ;PROTECTION FAILURE
PASSI1: TLO IOS,WRITEB ;ALLOW WRITE ACCESS
AOS (P) ;SUCCESS
JRST DPOPJ
PASSET: MOVE TAC,JBTPRV(J)
TLNE TAC,UDPPRV ;LET DUMPER IN ALWAYS(1,2)
JRST PASSE1
TLZN IOS,WRITEB ;CAN HE DO THIS?
JRST ENOENT ;NO
PASSE1: MOVE TAC,['PASS ']
MOVEM TAC,DSKDAT(DDB)
MOVEM TAC,DSKDAT+1(DDB)
XCTR XR,[MOVE TAC,(UUO)] ;GET NEW PASS WORD!
MOVEM TAC,DSKDAT+2(DDB)
SETZM DSKDAT+3(DDB)
HRRI TAC,DSKDAT+3(DDB)
HRL TAC,TAC
ADDI TAC,1
BLT TAC,DSKDAT+SECSIZ-1(DDB) ;CLEAR THE REST
MOVEI DAT,PASOUT ;WRITE IN PASS WORD BLOCK
PUSHJ P,NEWAIT
TRNE IOS,IODERR!IODTER ;ERRORS?
JRST EGARB1
JRST PASSI1 ;OK
;****** I-LEVEL SUBR ******
PASOUT: SKIPA TAC,[DWRITE!IOPCHN] ;WRITE
PASSIN: MOVEI TAC,IOPCHN ;READ
MOVSM TAC,TFRCTL(DDB)
MOVE TAC,[XWD -SECSIZ,DSKDAT]
ADDI TAC,(DDB)
MOVEM TAC,TFRIOW(DDB)
LDB TAC,PUNIT
LDB TAC,[POINT 32,NCYLSH+FPACKS(TAC),31]
IMULI TAC,BKPTRK*TRKCYL
SUBI TAC,1
ADD TAC,UDPOFF(DDB) ;ADD BASE ADDRESS
LSH TAC,6 ;RECORD 0
MOVEM TAC,TFRSEC(DDB)
JRST TSTART ;DO IT